/* @(#)tbcopytk.c	17.1.1.1 (ES0-DMD) 01/25/02 17:47:11 */
/*===========================================================================
  Copyright (C) 1995 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 Massachusetss Ave, Cambridge, 
  MA 02139, USA.
 
  Corresponding 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
===========================================================================*/

/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.TYPE        Module
.NAME        tbcopytk.c
.LANGUAGE    C
.AUTHOR      IPG-ESO Garching  
.CATEGORY    table utilities
.RETURNS
	status
.PURPOSE    

\begin{TeX}

Copy table entry(s) into a keyword.
If columns are not defined in the command, the full table row
is copied into the keyword. 
If the keyword does not exist, it is created by the program.
This command is equivalent to the MCL statement
keyword = table,column,row 

Parameters:
\begin{description}
\item[p1]    table name.
\item[p2-pj] column reference(s).
\item[pj+1]  entry (row) number.
\item[pj+2]  output keyword.
\end{description}

\end{TeX}


.VERSION     1.0 25-Mar-1990   Definition     J.D. Ponz
. Corrected 7-Mar-1990                        M.Peron
. Corrected 8-Oct-1990                        M,Peron
------------------------------------------------------------*/
#include <stdio.h>
#include <midas_def.h>
#include <tbldef.h>
#include <tblcnt.h>

#define STRINGLEN 256
#define PARLEN    80
#define NCOL      10

tbl_copytk()

{ char table[PARLEN], column[PARLEN], line[STRINGLEN];
  char form[9], ws[10], keyw[PARLEN], kname[10], cval[STRINGLEN], *kun;
  int  tid, ncol, nrow, nsort, ncall, nrall, niden, knul;
  int  len, i, status, ival, ierr, ic, irow, type, k, iav, sel;
  int  ktype, istart, nval, j, npar, inull[NCOL], ibuf[NCOL], icol[NCOL];
  float rval, rerr, rbuf[NCOL];
  double dval, derr, dbuf[NCOL];
  double atof();

  ierr = 0; rerr = 0; derr = 0;

  status = SCKRDI("PCOUNT",1,1,&iav,&npar,&kun,&knul);
  if (npar < 3) {SCTPUT("Wrong number of parameters");
                 return (status);
                }
                                                /* read parameter */
  status = tbl_getpar("P1",PARLEN,table);
                                                /* open tablefile */
  status = TCTOPN(table, F_I_MODE, &tid);
  if (status != ERR_NORMAL) {SCTPUT("Error opening the table");
                             return (status);
                            }
  TCIGET(tid, &ncol, &nrow, &nsort, &ncall, &nrall);
                                                /* read keyword */
  sprintf(ws,"P%d",npar);
  status = tbl_getpar(ws,PARLEN,keyw);
  for (i=0; i<PARLEN && keyw[i] != '/' && 
                        keyw[i] != '\0' &&
                        keyw[i] != ' '; i++) kname[i] = keyw[i];
  kname[i] = '\0';
  ktype    = D_R4_FORMAT;
  istart   = 1;
  nval     = 1;  
  if (keyw[i] == '/')                       /* decode keyword type...*/
     { switch (keyw[i+1]) {
       case 'c':
       case 'C': ktype = D_C_FORMAT; break;
       case 'i':
       case 'I': ktype = D_I4_FORMAT; break;
       case 'd':
       case 'D': ktype = D_R8_FORMAT; break;
       default : ktype = D_R4_FORMAT; break;
       }
       for (j=i+3, i=0; j<PARLEN && keyw[j] != '/' && 
            keyw[j] != '\0' && keyw[j] != ' '; j++, i++) 
            cval[i] = keyw[j];
       cval[i] = '\0';
       istart  = atoi(cval);
       i = j; 
       for (j=i+1, k=0; j<PARLEN && keyw[j] != '/' && 
            keyw[j] != '\0' && keyw[j] != ' '; j++, k++) 
            cval[k] = keyw[j];
       cval[k] = '\0';
       nval    = atoi(cval);
     }
    
                                                /* read row */
  npar = npar -1;
  sprintf(ws,"P%d",npar);
  status = tbl_getpar(ws,PARLEN,line);
  if (line[0] == '@')                           /* sequence number */
      irow = atoi(line+1);
  else
      {TCKGET(tid, &niden);                     /* value in reference column */
       if (niden==0) irow = atoi(line);
       else {
             if (nsort != niden) {SCTPUT("Reference column is not sorted");
                                  return(status);
                                 } 
             TCFGET(tid, niden, form, &len, &type);
             switch (type) {
             case D_I1_FORMAT:
             case D_I2_FORMAT:
             case D_I4_FORMAT: ival = atoi(line);
                               TCESRI(tid,niden,ival,ierr,1,&irow);
                               break;
             case D_R4_FORMAT: rval = atof(line);
                               TCESRR(tid,niden,rval,rerr,1,&irow);
                               break;
             case D_R8_FORMAT: dval = atof(line);
                               TCESRD(tid,niden,dval,derr,1,&irow);
                               break;
             case D_C_FORMAT:  if (line[0] != '"') 
                                 {SCTPUT("Wrong Data Type");
                                  SCTPUT("Reference column is character ");
                                  return(status);
                                 }
                               for (i=1; i<STRINGLEN && line[i] != '"'; i++);
                               line[i] = '\0';
                               TCESRC(tid,niden,line,2,i,1,&irow);
                               break;
             }
            if (irow <= 0) {SCTPUT("Entry not found");
                            return(status);
                           }
            }
      }
  TCSGET(tid, irow, &sel);
  if (sel == 0) {SCTPUT("Entry not selected");
                 return(status);
                }
                                                /* read column */
  ncol = 0;
  for (i=2; i<npar; i++)
      {sprintf(ws,"P%d",i);
       status = tbl_getpar(ws,PARLEN,line);
       TCCSER(tid,line,&ic);
       if (ic < 0) 
          {SCTPUT("Column not found");
          return(status);}
       else        
          {icol[ncol] = ic;
           ncol++;}
      }

  if (ncol == 0)
     { switch (ktype) {
       case D_C_FORMAT: ic = 1; ncol = 1; break;
       default:         ncol = nval; ic = 1;
                        for (i=0; i<ncol; i++) icol[i] = i+1;
                        break;
       }
     }

                                                 /* read table */
  switch(ktype) {
  case D_I4_FORMAT: if (ncol==1) {TCERDI(tid,irow,ic,&ival,&knul);
                                  ibuf[0] = ival;}
                    else          TCRRDI(tid,irow,ncol,icol,ibuf,inull);
                    SCKWRI(kname, ibuf, istart, nval, kun);
                    break;   
  case D_R4_FORMAT: if (ncol==1) {TCERDR(tid,irow,ic,&rval,&knul);
                                  rbuf[0] = rval;}
                    else          TCRRDR(tid,irow,ncol,icol,rbuf,inull);
                    SCKWRR(kname, rbuf, istart, nval, kun);
                    break;   
  case D_R8_FORMAT: if (ncol==1) {TCERDD(tid,irow,ic,&dval,&knul);
                                  dbuf[0] = dval;}
                    else          TCRRDD(tid,irow,ncol,icol,dbuf,inull);
                    SCKWRD(kname, dbuf, istart, nval, kun);
                    break;   
  case D_C_FORMAT:  TCERDC(tid,irow,ic,cval,&knul);
                    knul = 0;
                    for (i=0; i<nval; i++) 
                        {knul = (cval[i] == '\0' || knul == 1) ? 1 : 0 ;
                         if (knul == 1) cval[i] = ' ';
                        }
                    SCKWRC(kname, 1, cval, istart, nval, kun);
                    break;   
  }

  TCTCLO(tid);   
   
  return (status);
}