Initial commit

1 files changed, 121 insertions, 0 deletions

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