/* @(#)fitsrhd.c	14.2 (ESO-DMD) 03/31/00 09:31:58 */
/*===========================================================================
  Copyright (C) 1996 European Southern Observatory (ESO)
 
  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 of 
  the License, 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 Massachusetts Ave, Cambridge, 
  MA 02139, USA.
 
  Correspondence concerning ESO-MIDAS should be addressed as follows:
	Internet e-mail: midas@eso.org
	Postal address: European Southern Observatory
			Data Management Division 
			Karl-Schwarzschild-Strasse 2
			D 85748 Garching bei Muenchen 
			GERMANY
===========================================================================*/

/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.COPYRIGHT  (c)  1996   European Southern Observatory
.IDENT      fitsrhd.c
.LAUGUAGE   C
.AUTHOR     P.Grosbol   ESO/IPG
.KEYWORDS   FITS header, decode, transport format
.COMMENT    Both main and extension headers are decoded.
.VERSION    1.0  1988-Dec-10 : Creation,   PJG 
.VERSION    1.1  1989-Jul-05 : Include more data type in tables, PJG 
.VERSION    1.2  1989-Aug-24 : Change .BDF data formats, PJG 
.VERSION    1.3  1989-Oct-23 : Create table for RGROUP, PJG 
.VERSION    1.35 1990-Mar-08 : Change CUNIT desc. to C*1, PJG 
.VERSION    1.4  1990-Mar-21 : Check file data format, PJG 
.VERSION    1.5  1990-Nov-07 : Add table display format, PJG 
.VERSION    1.55 1990-Nov-09 : If scale change table-col to 'E', PJG 
.VERSION    2.0  1991-Mar-04 : Change call-sequence and structures, PJG 
.VERSION    2.05 1991-Apr-03 : Update for Binary tables, PJG 
.VERSION    2.1  1991-Apr-16 : Create zero with colums, PJG 
.VERSION    2.20 1991-Sep-23 : Add BINTABLE field types C,M,P, PJG 
.VERSION    2.30 1992-Aug-12 : Correct C,M,P formats and GCOUNT, PJG 
.VERSION    2.40 1992-Aug-13 : Include IMAGE extension, PJG 
.VERSION    2.50 1993-Oct-29 : Update to new ST-routines + prototypes, PJG 
.VERSION    2.55 1993-Oct-29 : Initiate O_TIME and O_POS, PJG 
.VERSION    2.60 1993-Dec-03 : Correct pointer type in dread call, PJG 
.VERSION    2.65 1994-Jun-28 : Include D_UI2_FORMAT, PJG 
.VERSION    2.70 1994-Sep-29 : Initiate O_TIME also in tables, PJG 
.VERSION    2.75 1995-Jun-07 : use F_TRANS and check TDISP format, PJG 
.VERSION    2.80 1996-Feb-12 : Create CRVAL descriptor, PJG 
.VERSION    2.85 1996-Dec-13 : Check format for scaled int-columns, PJG 
.VERSION    2.90 1997-Nov-19 : use SCFCRE with F_H_MODE + SCFMOD to create
			       the Midas images,  KB
.VERSION    2.95 1998-Apr-22 : Change BTABLE 'B' format to I2, PJG 
.VERSION    3.00 1999-Mar-30 : Allow empty files if hist=='A', PJG
.VERSION    3.05 1999-Apr-30 : Store IDENT for empty data images, PJG

 010731		last modif 

---------------------------------------------------------------------*/

#include   <fitsfmt.h>               /* general data definitions     */
#include   <fitsdef.h>               /* basic FITS definitions       */
#include   <fitskwt.h>               /* Table Extension definitions  */
#include   <midas_def.h>


typedef struct 
   {					/* one FITS header line         */
   char   c[80];
   } LINE;

/*

*/

#ifdef __STDC__
int fitsrhd(int *pmfd, BFDEF *bfdef, int *psize, int *pmfdt, char fmt, 
            char hist, int popt, int Midas_flag)
#else
int fitsrhd(pmfd,bfdef,psize,pmfdt,fmt,hist,popt,Midas_flag)
/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE       Decode FITS header
.RETURN        type of FITS header, -1: error
---------------------------------------------------------------------*/
int        *pmfd;            /* OUT:    MIDAS file desc.             */
BFDEF      *bfdef;           /* OUT:    FITS header parm's           */
int        *psize;           /* OUT:    size of data matrix (bytes)  */
int        *pmfdt;           /* IN/OUT: MIDAS file desc. for groups  */
char       fmt;              /* IN:     MIDAS file format No/Orig/Fp */
char       hist;             /* IN:     History flag, No/Yes         */
int        popt;             /* IN:     Print level                  */
int        Midas_flag;       /* IN:     = 0, `usual' mode
					= 1, internal FITS access  
					= -1, only test FITS file type,
					      do not create internal 
					      FITS files	     */
#endif

{
char     *ifn, *tfn, *pc, line[80], outnam[40], label[MXS];

int      ktype, htype, i, n, nl, nx, nz, nrep, nfz, myempty;
int      ftype, dtype, xtype, na[MXDIM], unit[2], save_name;
int      mfd, mfdt, option, istat;

float    ff[4];

double   fa[MXDIM];

LINE     *pl;
KWORD    kw;
TXDEF    *txd;
ADEF     *ad;
PDEF     *pm;
FDEF     *fc;




htype = NOFITS; ktype = 1; nl = 0, unit[0] = 0, save_name = 0;
mfd = *pmfd; mfdt = *pmfdt; *psize = 0;

mdb_init();
myempty = 0;


if (Midas_flag >= 100)
   {
   myempty = 1;			/* save also empty primary header */
   if (Midas_flag >= 200)
      {				/* we're here from indisk.c */
      save_name = 1;
      Midas_flag -= 200;
      }
   else
      Midas_flag -= 100;
   }

do 
   {                                    /* go through FITS header  */
   if ((n=dread(&pc,FITSLR))!=FITSLR)	/* read FITS header blocks */
      return EOFITS;
      
   bfdef->count ++;
   pl = (LINE *) pc;
   for (n=0; n<36 && ktype; n++, pl++) 
      {					/* decode the 36 lines */
      nl++;
      fitsrkw(pl->c,&kw);		/* decode single keyword line */
      if (nl<5)
         {				/* check type of FITS header  */
         if ((htype=fitsthd(nl,&kw)) < FBFITS) return htype;
	 }
      if (1<popt) 
         {
         pl->c[79] = '\0';
         SCTPUT(pl->c);
         }
 
      /* decode KW */

      ktype = fitsckw(mfd,bfdef,htype,&kw,fmt,hist,Midas_flag);
      if (ktype<-1) return -1;

      if (0 < bfdef->cflag)
         {				/* create MIDAS frame   */
         switch (htype) 
            {
            case RGROUP :
             if (bfdef->pcount) 
                {
		tfn = newfn('T',"");
                dtype = D_R8_FORMAT; 
		txd = (TXDEF *) bfdef->extd;
                nz = 2 * bfdef->pcount;
		if (Midas_flag == 0)
                   {
                   ftype = F_TBL_TYPE;
                   option = F_O_MODE;
                   }
                else if (Midas_flag == -1)
		   goto next_step;
                else
                   {
                   ftype = F_FTBL_TYPE;
                   option = F_FO_MODE;
                   }
		istat = TCTINI(tfn,0,option,nz,bfdef->gcount,&mfdt);
                if (istat != ERR_NORMAL) return (-99);
                for (i=0; i<72; i++) line[i] = ' '; line[i] = '\0';
                SCDWRC(mfdt,"IDENT",1,line,1,72,unit);
                }

            case IMAGE  :
            case BFITS  :
             if (fmt=='O')			/* original format */
                switch (bfdef->bitpix)
                   {
                   case   8 : dtype = D_I1_FORMAT; break;
                   case  16 : dtype = D_I2_FORMAT; break;
                   case  32 : dtype = D_I4_FORMAT; break;
                   case -32 : dtype = D_R4_FORMAT; break;
                   case -64 : dtype = D_R8_FORMAT; break;
                   default  : return htype;
                   }
             else dtype = D_R4_FORMAT;		/* take float format */

             nfz = 1;				/* compute size in bytes */
             nx = (htype==RGROUP) ? bfdef->naxis-1 : bfdef->naxis;
	     if (1<bfdef->gcount) 
                {				/* add Group Dimension  */
		if (htype!=RGROUP) bfdef->naxis++;
		bfdef->data[bfdef->naxis-1].naxis = bfdef->gcount;
		}

             for (i=0; i<nx; i++) nfz *= bfdef->data[i].naxis;
             nfz = (bfdef->naxis) ?
	           bfdef->gcount * (nfz + bfdef->pcount) : 0;

             i = (bfdef->bitpix<0) ? -bfdef->bitpix/8 : bfdef->bitpix/8;
             *psize = i * nfz;
                    
             /* do we just want to know the FITS (extension) type? */

	     if (Midas_flag == -1) goto next_step;


             if ((myempty == 1) && (nfz == 0)) 
                nfz = 1;			/* so we create an image */
             else
                myempty = 0;

             if (nfz || hist=='A') 
                {				/* don't create empty file */
	        ifn = newfn('I',"");
                if (Midas_flag == 1)
                   {
                   ftype = F_FIMA_TYPE;		/* header -> memory */
                   option = F_O_MODE;	
                   }
                else
                   {
                   ftype = F_IMA_TYPE;	
                   option = F_H_MODE;		/* only header -> disk */
                   }
	        istat = SCFCRE(ifn,dtype,option,ftype,nfz,&mfd);
                if (istat != ERR_NORMAL) return (-99);
                if (myempty == 1) nfz = 0;	/* reset nfz */
	        }

	     else if (bfdef->mtype == F_FIT_TYPE) 
                {
		ifn = newfn('F',""); 
                if (Midas_flag == 1)
                   ftype = F_FFIT_TYPE;
                else
                   ftype = F_FIT_TYPE;

		istat = SCFCRE(ifn,dtype,F_O_MODE,ftype,1,&mfd);
                if (istat != ERR_NORMAL) return (-99);
		bfdef->naxis = 1;
		bfdef->data[0].naxis = 1;
		}

	     if (0 <= mfd)
                {
		for (i=0; i<72; i++) line[i] = ' '; line[i] = '\0';
		SCDWRI(mfd,"NAXIS",&bfdef->naxis,1,1,unit);
		if (0<bfdef->naxis)
                   {
		   for (i=0; i<bfdef->naxis; i++)
		      na[i] = bfdef->data[i].naxis;
		   SCDWRI(mfd,"NPIX",na,1,bfdef->naxis,unit);
		   for (i=0; i<MXDIM; i++) fa[i] = 1.0;
		   SCDWRD(mfd,"START",fa,1,bfdef->naxis,unit);
		   SCDWRD(mfd,"STEP",fa,1,bfdef->naxis,unit);
		   SCDWRC(mfd,"IDENT",1,line,1,72,unit);
		   SCDWRC(mfd,"CUNIT",1,line,1,16*(bfdef->naxis+1),unit);
		   for (i=0; i<4; i++) ff[i] = 0.0;
		   SCDWRR(mfd,"LHCUTS",ff,1,4,unit);
		   }
 		for (i=0; i<MXDIM; i++) fa[i] = 0.0;
		SCDWRD(mfd,"O_POS",fa,1,3,unit);
		SCDWRD(mfd,"O_TIME",fa,1,7,unit);
                }
             break;

            case ATABLE :
            case BTABLE :
             dtype = D_R4_FORMAT; 
	     txd = (TXDEF *) bfdef->extd;
	     nz = 0;
	     for (i=0; i<txd->tfields; i++)
                {
                fc = &txd->col[i];
		nrep = (0<fc->trepn) ? fc->trepn : 1;
		nrep *= fc->tncpf;
		switch (fc->tdfmt) 
                   {
		   case 'A' : nz += (nrep*fc->twdth-1)/4 + 1;
			      break;
		   case 'L' : nz += (nrep-1)/4 + 1;
			      break;
		   case 'X' : nz += (nrep-1)/32 + 1;
			      break;
		   case 'B' : 
		   case 'S' : nz += (nrep-1)/2 + 1;
			      break;
		   case 'I' : 
		   case 'C' : 
		   case 'P' : 
		   case 'E' : nz += nrep * fc->tncpf; 
                              break;
		   case 'M' : 
		   case 'D' : nz += 2 * nrep * fc->tncpf; 
                              break;
		   }
                }
             *psize = bfdef->pcount +
		      (bfdef->data[0].naxis * bfdef->data[1].naxis);

	     if (Midas_flag == 0)
                {
                ftype = F_TBL_TYPE;
                option = F_O_MODE;
                }
             else if (Midas_flag == -1)
		goto next_step;
             else
                {
                ftype = F_FTBL_TYPE;
                option = F_FO_MODE;
                }

             nz += 3; i = F_TRANS;
	     tfn = newfn('T',"");
	     istat = TCTINI(tfn,i,option,nz,bfdef->data[1].naxis,&mfd);
             if (istat != ERR_NORMAL) return (-99);
             for (i=0; i<72; i++) line[i] = ' '; line[i] = '\0';
             SCDWRC(mfd,"IDENT",1,line,1,72,unit);
	     for (i=0; i<MXDIM; i++) fa[i] = 0.0;
	     SCDWRD(mfd,"O_TIME",fa,1,7,unit);
             break;

            default     :
	     return htype;
            }

        next_step:
	 mdb_get(mfd);
         bfdef->cflag = -1;
         }
      }

   } while (ktype);

i = (int) strlen(bfdef->extname);
if (i > 0)
   {
   if (i > 16) i = 16;
   CGN_FILL(line,' ',16);
   (void) strncpy(line,bfdef->extname,i);
   line[16] = '\0';
   if (0 <= mfd)
      SCDWRC(mfd,"EXTNAME",1,line,1,16,&i);
   }
 

if (0 <= mfd)
   SCDWRC(mfd,"IDENT",1,bfdef->ident,1,strlen(bfdef->ident),unit);

if (bfdef->naxis && 0<=mfd) 
   {				/* update file descriptors if exits  */
   switch (htype)
      {
      case RGROUP  :
       if (bfdef->pcount && 0<=mfdt) 
          {
          pm = bfdef->parm;
          for (i=0; i<bfdef->pcount; i++) 
             {
             TCCINI(mfdt,D_R8_FORMAT,1,"E15.5"," ",pm->ptype,&nz);
             pm++;
             }
          }

      case IMAGE   :
      case BFITS   :
       if (nfz && fmt=='O') 
          {				 /* check data-format of file   */
          if (bfdef->sflag) 
             {
	     if (dtype==D_I2_FORMAT && 
	        bfdef->bscale==1.0 && bfdef->bzero==32768.0)
                {
		xtype = D_UI2_FORMAT;
		bfdef->bitpix = -16;
		bfdef->sflag = 0;
	        }
	     else
                xtype = D_R4_FORMAT;
	     }
          else switch (bfdef->bitpix)
             {
             case   8 : xtype = D_I1_FORMAT; break;
             case  16 : xtype = D_I2_FORMAT; break;
             case  32 : xtype = D_I4_FORMAT; break;
             case -32 : xtype = D_R4_FORMAT; break;
             case -64 : xtype = D_R8_FORMAT; break;
             default  : return htype;
             }
          if (dtype!=xtype) dtype = xtype;
          }

       if (Midas_flag == 1)
          option = 0;
       else
          option = nfz;

       SCFMOD(mfd,dtype,option);

       for (i=0; i<bfdef->naxis; i++)
          {					/* compute start pixel */
          ad = &bfdef->data[i]; 
          fa[i] = ad->crval - (ad->crpix-1.0) * ad->cdelt;
          }
       SCDWRD(mfd,"START",fa,1,bfdef->naxis,unit);
       for (i=0; i<bfdef->naxis; i++) fa[i] = bfdef->data[i].cdelt;
       SCDWRD(mfd,"STEP",fa,1,bfdef->naxis,unit);
       for (i=0; i<bfdef->naxis; i++) fa[i] = bfdef->data[i].crval;
       SCDWRD(mfd,"CRVAL",fa,1,bfdef->naxis,unit);
       for (i=0; i<bfdef->naxis; i++) fa[i] = bfdef->data[i].crpix;
       SCDWRD(mfd,"REFPIX",fa,1,bfdef->naxis,unit);
       for (i=0; i<bfdef->naxis; i++) fa[i] = bfdef->data[i].crota;
       SCDWRD(mfd,"ROTA",fa,1,bfdef->naxis,unit);
       SCDWRC(mfd,"CUNIT",1,bfdef->bunit,1,16,unit);
       for (i=0; i<bfdef->naxis; i++)
	  SCDWRC(mfd,"CUNIT",1,bfdef->data[i].ctype,16*(i+1)+1,16,unit);
       if (bfdef->mflag==3)
          {
	  ff[0] = bfdef->dmin; ff[1] = bfdef->dmax;
	  SCDWRR(mfd,"LHCUTS",ff,3,2,unit);
	  }
       i = (int) strlen(bfdef->extname);
       if (i > 0) 
          {
          if (i > 16) i = 16;
          CGN_FILL(line,' ',16);
          (void) strncpy(line,bfdef->extname,i);
          line[16] = '\0';
          SCDWRC(mfd,"EXTNAME",1,line,1,16,&i);
          }
       break;

      case ATABLE  :
      case BTABLE  :
           for (i=0; i<txd->tfields; i++) 
              {
	      fc = &txd->col[i];
	      nrep = (0<fc->trepn) ? fc->trepn : 1;
	      nrep *= fc->tncpf;
	      if (!(*fc->tdisp)) strcpy(fc->tdisp,fc->tform);
	      switch (fc->tdfmt) 
                 {
                 case 'A' :
                 case 'L' :
                  if (*fc->tdisp!='A') strcpy(fc->tdisp,fc->tform);
                  break;

                 case 'B' :
                 case 'S' :
                 case 'I' :
                  if (fc->sflag) 
                     {
		     if (*fc->tdisp!='F' && *fc->tdisp!='E' &&
		     *fc->tdisp!='D' && *fc->tdisp!='G')
		     (void) strcpy(fc->tdisp,"E15.5");
		     }
		  else 
                     {
		     if (*fc->tdisp!='I') strcpy(fc->tdisp,fc->tform);
		     }
                  break;

                 case 'X' :
                 case 'P' :
                  if (*fc->tdisp!='I') strcpy(fc->tdisp,fc->tform);
                  break;

                 default  :
                  if (*fc->tdisp!='F' && *fc->tdisp!='E' &&
		      *fc->tdisp!='D' && *fc->tdisp!='G')
		  (void) strcpy(fc->tdisp,fc->tform);
                  break;
		  }

             switch (fc->tdfmt) {
                  case 'A' :
                       TCCINI(mfd,D_C_FORMAT,nrep*fc->twdth,fc->tdisp,
                              fc->tunit,fc->ttype,&nz);
                       break;
                  case 'L' :
                       TCCINI(mfd,D_C_FORMAT,nrep,fc->tdisp,
                              fc->tunit,fc->ttype,&nz);
                       break;
                  case 'I' :
                       if (fc->sflag)
			 TCCINI(mfd,D_R4_FORMAT,nrep,fc->tdisp,
				fc->tunit,fc->ttype,&nz);
                       else TCCINI(mfd,D_I4_FORMAT,nrep,fc->tdisp,
				   fc->tunit,fc->ttype,&nz);
                       break;
                  case 'E' : 
                       TCCINI(mfd,D_R4_FORMAT,nrep,fc->tdisp,
                              fc->tunit,fc->ttype,&nz);
                       break;
                  case 'D' :
                       TCCINI(mfd,D_R8_FORMAT,nrep,fc->tdisp,
                              fc->tunit,fc->ttype,&nz);
                       break;
                  case 'S' :
                       if (fc->sflag)
			 TCCINI(mfd,D_R4_FORMAT,nrep,fc->tdisp,
				fc->tunit,fc->ttype,&nz);
                       else TCCINI(mfd,D_I2_FORMAT,nrep,fc->tdisp,
				   fc->tunit,fc->ttype,&nz);
                       break;
                  case 'B' :
                       if (fc->sflag)
			 TCCINI(mfd,D_R4_FORMAT,nrep,fc->tdisp,
				fc->tunit,fc->ttype,&nz);
                       else TCCINI(mfd,D_I2_FORMAT,nrep,fc->tdisp,
				   fc->tunit,fc->ttype,&nz);
                       break;
                  case 'X' :
                       nz = (nrep-1)/8 + 1;
                       TCCINI(mfd,D_I1_FORMAT,nz,fc->tdisp,
                              fc->tunit,fc->ttype,&nz);
                       break;
                  case 'C' : 
                       TCCINI(mfd,D_R4_FORMAT,nrep,fc->tdisp,
                              fc->tunit,fc->ttype,&nz);
                       break;
                  case 'M' :
                       TCCINI(mfd,D_R8_FORMAT,nrep,fc->tdisp,
                              fc->tunit,fc->ttype,&nz);
                       break;
                  case 'P' :
                       TCCINI(mfd,D_I4_FORMAT,nrep,fc->tdisp,
			      fc->tunit,fc->ttype,&nz);
                       break;
               }
           }
        break;
     }
  }

else 
   {                          /* compute size of unknown extension */
   nfz = 1;
   for (i=0; i<bfdef->naxis ; i++) nfz *= bfdef->data[i].naxis;
   nfz = (bfdef->naxis) ? bfdef->gcount*(nfz + bfdef->pcount) : 0;
   i = (bfdef->bitpix<0) ? -bfdef->bitpix/8 : bfdef->bitpix/8;
   *psize = i * nfz;

   switch (htype) 
      {
      case IMAGE   :
      case BFITS   : ftype = (bfdef->mflag==F_FIT_TYPE) ? 
                                 F_FIT_TYPE : F_IMA_TYPE;
	             break;
      case ATABLE  :
      case BTABLE  : ftype = F_TBL_TYPE; break;
      }
   }


if ((save_name == 1) || 
    ((0<bfdef->naxis || hist=='A') && 0<popt && popt<3))
   {					/* print file Ident., etc. */
   switch (htype) 
      {
      case IMAGE  :
      case BFITS  :
      case RGROUP :
       if (ftype == F_IMA_TYPE) 
          {
          istat = CGN_COPY(outnam,newfn('I',(char *) 0));
          if (save_name == 1)			/* here from indisk/mfits? */
             {
             (void) strcat(outnam,".bdf");
             (void) SCKWRC("F$OUTNAM",1,outnam,1,(istat+4),unit);
             outnam[istat] = '\0';		/* remove type again */
             }
          if (popt < 1) break;
             
          (void) sprintf(line,
	         "Image %-16.16s : %-16.16s , naxis: %2d, pixels: %8d, %5d",
          outnam,bfdef->ident,bfdef->naxis,
                bfdef->data[0].naxis,bfdef->data[1].naxis);
          SCTPUT(line);
          if (popt<2) break;

          for (i=0; i<bfdef->naxis; i++) 
             {
             ad = &bfdef->data[i];
             (void) sprintf(line,"      naxis  %3d : %6d, %10.2f %10.2f %-16s",
                        i+1,ad->naxis,
                        ad->crval-(ad->crpix-1.0)*ad->cdelt,ad->cdelt,
			ad->ctype);
             SCTPUT(line);
	     }
          }
       else if (ftype == F_FIT_TYPE) 
          {
          istat = CGN_COPY(outnam,newfn('F',(char *) 0));
          if (save_name == 1)			/* here from indisk/mfits? */
             {
             (void) strcat(outnam,".bdf");
             (void) SCKWRC("F$OUTNAM",1,outnam,1,(istat+4),unit);
             outnam[istat] = '\0';              /* remove type again */
             }
          if (popt < 1) break;
             
          (void) sprintf(line,"Fit   %-16.16s : %-16.16s",outnam,bfdef->ident);
          SCTPUT(line);
          }
       break;

      case ATABLE :
      case BTABLE :
       txd = (TXDEF *) bfdef->extd;
       istat = CGN_COPY(outnam,newfn('T',(char *) 0));
       if (save_name == 1)			/* here from indisk/mfits? */
          {
          (void) strcat(outnam,".tbl");
          (void) SCKWRC("F$OUTNAM",1,outnam,1,(istat+4),unit);
          outnam[istat] = '\0';              /* remove type again */
          }
       if (popt < 1) break;
             
       (void) sprintf(line,"Table %-16.16s : %-16.16s , Table r,c: %8d, %5d",
                   outnam,bfdef->ident,bfdef->data[1].naxis,txd->tfields);
       SCTPUT(line);
       if (popt<2) break;

       for (i=0; i<txd->tfields; i++) 
          {
          fc = &txd->col[i];
          (void) sprintf(line,
               "      column %3d : %-16.16s, %-16.16s, %-16.16s",
               i+1,fc->ttype,fc->tform,fc->tunit);
          SCTPUT(line);
          }
       break;

      default : break;
      }
   }

if (0 <= mfd) *pmfd = mfd;
if (0 <= mfdt) *pmfdt = mfdt;
text_close();

return htype;
}