/* @(#)fitswmd.c	17.1.1.1 (ES0-DMD) 01/25/02 17:39: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
===========================================================================*/

/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.COPYRIGHT  (c)  1998   European Southern Observatory
.IDENT      fitswmd.c
.LAUGUAGE   C
.AUTHOR     P.Grosbol   ESO/IPG
.KEYWORDS   MIDAS descriptor, FITS header, keywords
.COMMENT    write MIDAS descriptor in FITS header
.VERSION    1.0  1988-Dec-04 : Creation,   PJG 
.VERSION    1.1  1989-May-26 : Change format - for old-MIDAS,   PJG 
.VERSION    1.2  1989-Jun-12 : Change definition of unit+kunit, PJG 
.VERSION    1.3  1990-Feb-26 : Change format of char. desc., PJG 
.VERSION    1.4  1991-Jan-25 : Change include file, PJG 
.VERSION    1.5  1993-Oct-26 : Update to new SC + prototypes, PJG 
.VERSION    1.6  1998-Aug-19 : Change format, PJG 
.VERSION    1.7  2002-Jan-11 : Add logical type, PJG 
---------------------------------------------------------------------*/
#include   <stdio.h>
#include   <string.h>
#include   <fitsfmt.h>
#include   <fitsdef.h>
#include   <midas_def.h>

#define    MXFHC              80   /* characters in FITS header card */
#define    MXFCC              70   /* max. char. in FITS comment     */

int fitswmd(mfd,name)
/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE       write MIDAS descriptor to FITS header
.RETURN        return status  0:OK, -1:error
---------------------------------------------------------------------*/
int           mfd;             /* IN: MIDAS file number              */
char        *name;             /* IN: name of MIDAS descriptor       */
{
  char      *pc, c, type;
  char      fhc[MXFHC+1], buf[MXFCC+1];
  int       ne, nbpe, n, nv, nf, no, epl, null, net;
  int       ival[7], unit[4];
  float     fval[5];
  double    dval[3];

  for (n=0; n<MXFHC; n++) fhc[n] = ' '; fhc[n] = '\0';

  if (MXMDN<=strlen(name)) {
    sprintf(fhc,"Error: descriptor >%s< skipped - name too long\n",
	    name);
    SCTPUT(fhc);
    return -1;
  }

  if (SCDFND(mfd,name,&type,&ne,&nbpe)) return -1;

  switch (type) {
     case 'L' :
          sprintf(fhc," '%s','L*%d',1,%d,'35I2'",name,nbpe,ne);
          fitswkc("HISTORY",fhc);
          nf = 1; epl = 35;
          while (ne) {                  /* go through all elements   */
             no = (epl<ne) ? epl : ne;
             for (n=0; n<MXFHC; n++) fhc[n] = ' ';
             SCDRDL(mfd,name,nf,no,&nv,ival,unit,&null);
             nf += nv; ne -= nv; n = 0; pc = &fhc[1];
             while (nv--) {             /* write one HISTORY card    */
                sprintf(pc,"%2d",ival[n]);
                pc += 2; n++;
             }
             fitswkc("HISTORY",fhc);
          }
          break;
     case 'I' :
          sprintf(fhc," '%s','I*%d',1,%d,'7I10'",name,nbpe,ne);
          fitswkc("HISTORY",fhc);
          nf = 1; epl = 7;
          while (ne) {                  /* go through all elements   */
             no = (epl<ne) ? epl : ne;
             for (n=0; n<MXFHC; n++) fhc[n] = ' ';
             SCDRDI(mfd,name,nf,no,&nv,ival,unit,&null);
             nf += nv; ne -= nv; n = 0; pc = &fhc[1];
             while (nv--) {             /* write one HISTORY card    */
                sprintf(pc,"%10d",ival[n]);
                pc += 10; n++;
             }
             fitswkc("HISTORY",fhc);
          }
          break;
     case 'R' :
          sprintf(fhc," '%s','R*%d',1,%d,'5E14.7'",name,nbpe,ne);
          fitswkc("HISTORY",fhc);
          nf = 1; epl = 5;
          while (ne) {                  /* go through all elements   */
             no = (epl<ne) ? epl : ne;
             for (n=0; n<MXFHC; n++) fhc[n] = ' ';
             SCDRDR(mfd,name,nf,no,&nv,fval,unit,&null);
             nf += nv; ne -= nv; n = 0; pc = &fhc[1];
             while (nv--) {             /* write one HISTORY card    */
                sprintf(pc,"%14.7E",fval[n]);
                pc += 14; n++;
             }
             fitswkc("HISTORY",fhc);
          }
          break;
     case 'D' :
          sprintf(fhc," '%s','R*%d',1,%d,'3E23.15'",name,nbpe,ne);
          fitswkc("HISTORY",fhc);
          nf = 1; epl = 3;
          while (ne) {                  /* go through all elements   */
             no = (epl<ne) ? epl : ne;
             for (n=0; n<MXFHC; n++) fhc[n] = ' ';
             SCDRDD(mfd,name,nf,no,&nv,dval,unit,&null);
             nf += nv; ne -= nv; n = 0; pc = &fhc[1];
             while (nv--) {             /* write one HISTORY card    */
                sprintf(pc,"%23.15E",dval[n]);
                pc += 23; n++;
             }
             fitswkc("HISTORY",fhc);
          }
          break;
     case 'C' :
          if (MXFCC<=nbpe) {
             sprintf(fhc,"Warning: descriptor >%s< skipped - too long C*%d\n",
                     name,nbpe);
             SCTPUT(fhc); break;
	  }
          epl = (MXFCC < ne*nbpe) ? MXFCC : ne*nbpe;
          sprintf(fhc," '%s','C*%d',1,%d,'%dA1'",name,nbpe,ne,epl);
          fitswkc("HISTORY",fhc);
          nf = 1; n = 1; net = ne*nbpe; fhc[0] = ' ';
          while (net) {                 /* go through all elements   */
             if (nbpe==1) no = (epl<net) ? epl : net; else no = 1;
             pc = buf;
             SCDRDC(mfd,name,nbpe,nf,no,&nv,pc,unit,&null);
             if (nv<=0) break;
             nf += nv; nv *= nbpe; net -= nv;
             while (nv--) {
                c = *pc++;
                if (c=='\\' || c=='\n') {
                   fhc[n++] = '\\';
                   if (MXFCC<n) {
                      fhc[n] = '\0'; fitswkc("HISTORY",fhc); n = 1;
		   }
                   if (c=='\\') fhc[n++] = '\\';
                   else if (c=='\n') fhc[n++] = 'n';
		 }
                 else if (' '<=c && c<='~') fhc[n++] = c;
                 else fhc[n++] = ' ';
                 if (MXFCC<n) {
                    fhc[n] = '\0'; fitswkc("HISTORY",fhc); n = 1;
                 }
	     }
          }
          if (1<n) { fhc[n] = '\0'; fitswkc("HISTORY",fhc); }
          break;
  }
  fitswkc("HISTORY","");
  return 0;
}