/* @(#)tb3dtest.c	17.1.1.1 (ESO-DMD) 01/25/02 17:47:26 
 *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 *
 *.COPYRIGHT   (C) 1998 European Southern Observatory
 *
 *.IDENT       tb3dtest.c
               3d table test program taken from: fors_t3dextract.c 
	       KBanse, 990224
 *
 *.KEYWORDS    3d tables, subtable extraction
 *
 *.USAGE       run fors_t3dextract.exe
 *
 *.INPUT       SOURCE      Source 3d table file
 *             SCOLUMN     Source column label
 *             SROW        Row number of source table
 *             TCOLUMN     Column label of target table
 *             NVAL        Number of values to copy
 *
 *.OUTPUT      TARGET      Table name for extracted element array
 *
 *.RETURNS     The program returns 0 on success or 1 on error. The exit
 *             status is stored in keyword Q1.
 *
 *.PURPOSE     Extract an element array from the table column denoted
 *             by SCOLUMN. The one dimensional array is copied to a column
 *             of an ordinary table. The output column is created if it does
 *             not already exist. If the column is already defined it is
 *             replaced. The output table is created if it does not already
 *             exist.
 *
 *.COMMENT     The FORS version of t3dextract differs from the general
 *             t3dextract in the way errors are handled and the format
 *             of the message output. For terminal output the FORS version
 *             uses 'messout' instead of SCTPUT and/or SCETER.
 *
 *.ENVIRON     MIDAS 98NOV, FORS pipeline
 *
 *.LANGUAGE    ANSI C
 *
 *.AUTHOR      R. Palsa, ESO-DMO
 *
 *.VERSION     0.1 1998/12/18: Creation, RP
 *
 *----------------------------------------------------------------------------
 */

/* Define _POSIX_SOURCE to indicate that this is a POSIX program */

#define  _POSIX_SOURCE 1


#include <stdio.h>
#include <midas_def.h>
#include <tblsys.h>
#include <tblerr.h>



#define  MSG_BUFFER_SIZE 256



#ifdef __STDC__
void error(int msglev, char *msg) 
#else
void error(msglev, msg)
int  msglev;
char  *msg;
#endif


{

  SCTPUT( msg);
  SCSEPI();
}



main() {


  int    i, nval, unit, null, idum;
  int    ndata, create;
  int    t2id, t2cno, t2nrow, t2ctype, t2csize, t2cbytes;
  int    t3id, t3cno, t3rno, t3ctype, t3csize, t3cbytes, t3store;
  int    msglev = 0;
  int    state = 0;

  char   *t3eptr;
  char   msg[MSG_BUFFER_SIZE];
  char   t2name[TBL_NAMLEN + 1], t2column[TBL_LABLEN + 1];
  char   t3name[TBL_NAMLEN + 1], t3column[TBL_LABLEN + 1];
  char   t3format[TBL_FORLEN + 1], t3unit[TBL_UNILEN + 1];



  /*
   * Connect to MIDAS
   */

  SCSPRO("tb3dtest");


  /*
   * Get keywords from environment
   */

  SCKGETC("SOURCE", 1, TBL_NAMLEN, &nval, t3name);
  SCKGETC("TARGET", 1, TBL_NAMLEN, &nval, t2name);
  SCKGETC("SCOLUMN", 1, TBL_LABLEN, &nval, t3column);
  SCKGETC("TCOLUMN", 1, TBL_LABLEN, &nval, t2column);
  SCKRDI("SROW", 1, 1, &nval, &t3rno, &unit, &null);
  SCKRDI("NDATA", 1, 1, &nval, &ndata, &unit, &null);
  SCKRDI("CREATE", 1, 1, &nval, &create, &unit, &null);


  /*
   * Get input table information
   */

  if (TCTOPN(t3name, F_I_MODE, &t3id)) {
    sprintf(msg, "Cannot open input table %s!", t3name);
    error(msglev, msg);
  }

  TCCSER(t3id, t3column, &t3cno);
  if (t3cno < 0) {
    TCTCLO(t3id);

    sprintf(msg, "Column %s not found.", t3column);
    error(msglev, msg);
  }
  else {
    TCBGET(t3id, t3cno, &t3ctype, &t3csize, &t3cbytes);
    TCFGET(t3id, t3cno, t3format, &nval, &idum);
    TCUGET(t3id, t3cno, t3unit);

    if (TCAMAP(t3id, t3rno, t3cno, &t3eptr)) {
      TCTCLO(t3id);
      error(msglev, "Cannot map table element!");
    }
  }


  /*
   * Get output table information
   */

  if (create)
    state = TCTINI(t2name, F_TRANS, F_O_MODE, 1, t3csize, &t2id);
  else
    state = TCTOPN(t2name, F_IO_MODE, &t2id);

  if (state) {
    TCAUNM(t3id, t3eptr);
    TCTCLO(t3id);

    sprintf(msg, "Cannot open output table %s!", t2name);
    error(msglev, msg);
  }

  TCCSER(t2id, t2column, &t2cno);
  if (t2cno < 0) {
    nval = t3ctype == D_C_FORMAT ? t3cbytes / t3csize : 1;

    if (TCCINI(t2id, t3ctype, nval, t3format, t3unit, t2column, &t2cno)) {
      TCAUNM(t3id, t3eptr);
      TCTCLO(t3id);
      TCTCLO(t2id);

      sprintf(msg, "Cannot initialize output column %s!", t2column);
      error(msglev, msg);
    }
  }

  TCIGET(t2id, &idum, &t2nrow, &idum, &idum, &idum);
  TCBGET(t2id, t2cno, &t2ctype, &t2csize, &t2cbytes);


  /*
   * If number of array elements is not given, the full number
   * of elements is used.
   */

  if (ndata <= 0)
    ndata = t3csize;


  /*
   * Copy element array to table column
   */

  switch (t3ctype) {
  case D_C_FORMAT:
    nval = t3cbytes / t3csize;

    for (i = 0; i < ndata && !state; i++)
      state = TCEWRC(t2id, i + 1, t2cno, t3eptr + i * nval);

    break;

  case D_I4_FORMAT:
    for (i = 0; i < ndata && !state; i++)
      state = TCEWRI(t2id, i + 1, t2cno, (int *)t3eptr + i);
    break;

  case D_R4_FORMAT:
    for (i = 0; i < ndata && !state; i++)
      state = TCEWRR(t2id, i + 1, t2cno, (float *)t3eptr + i);
    break;

  case D_R8_FORMAT:
    for (i = 0; i < ndata && !state; i++)
      state = TCEWRD(t2id, i + 1, t2cno, (double *)t3eptr + i);
    break;

  default:
    TCAUNM(t3id, t3eptr);
    TCTCLO(t3id);
    TCTCLO(t2id);

    sprintf(msg, "Data type of column %s is not supported!", t2column);
    error(msglev, msg);
    break;
  }

  if (state) {
    TCAUNM(t3id, t3eptr);
    TCTCLO(t3id);
    TCTCLO(t2id);

    error(msglev, "Cannot write table element!");
  }


  /*
   * Cleanup 
   */

  TCAUNM(t3id, t3eptr);
  TCTCLO(t3id);
  TCTCLO(t2id);


  /*
   * Disconnect from MIDAS
   */

  SCSEPI();

}