/* @(#)f77fmt.c	17.1.1.1 (ES0-DMD) 01/25/02 17:39:08 */
/*===========================================================================
  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)  1992   European Southern Observatory
.IDENT         f77fmt.c
.LAUGUAGE      C
.AUTHOR        P.Grosbol   ESO/IPG
.KEYWORDS      F77 format, list directed input
.COMMENT       decode F77 formats, perform list directed input
.VERSION       1.0  1988-Oct-15 : Creation,   PJG 
.VERSION       1.1  1989-Mar-13 : Include G-format,   PJG 
.VERSION       1.2  1989-Jul-03 : Correct terminater and getval, PJG 
.VERSION       1.3  1989-Dec-21 : Accept also lower case, PJG 
.VERSION       1.4  1991-Mar-21 : Add 'B' format, PJG 
.VERSION       1.5  1992-Aug-12 : Add P,C,M formats for BINTABLE, PJG 
---------------------------------------------------------------------*/

int dcffmt(pfmt,rep,type,wdth,dig)
/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE       decode F77 format
.RETURN        return status - 0:OK, 1:error
---------------------------------------------------------------------*/
char         *pfmt;       /* IN:  pointer to string with F77 format  */
int           *rep;       /* OUT: format repeatition factor          */
char         *type;       /* OUT: format type (A,I,E,D,L,..)         */
int          *wdth;       /* OUT: format width                       */
int           *dig;       /* OUT: digites specified in format        */
{
  int         i;
  char     *fmt;

  *rep = 1; *type = '\0'; *wdth = 0; *dig = 0;

  if ('0'<= *pfmt && *pfmt<='9') {      /* decode repeatition factor */
     i = 0;
     while ('0'<= *pfmt && *pfmt<='9')
           i = 10*i + (*pfmt++) - '0';
     *rep = i;
  }

  fmt = pfmt;
  switch (*pfmt++) {                    /* check type of format      */
     case 'a' :
     case 'A' : *type = 'A'; break;
     case 'i' :
     case 'I' : *type = 'I'; break;
     case 'f' :
     case 'F' : *type = 'E'; break;
     case 'g' :
     case 'G' : *type = 'E'; break;
     case 'e' :
     case 'E' : *type = 'E'; break;
     case 'd' :
     case 'D' : *type = 'D'; break;
     case 'j' :
     case 'J' : *type = 'J'; break;
     case 'l' :
     case 'L' : *type = 'L'; break;
     case 'x' : 
     case 'X' : *type = 'X'; break;
     case 'b' : 
     case 'B' : *type = 'B'; break;
     case 'c' : 
     case 'C' : *type = 'C'; break;
     case 'm' : 
     case 'M' : *type = 'M'; break;
     case 'p' : 
     case 'P' : *type = 'P'; break;
     default  : return 1;
  }

  i = 0;                                /* decode format width      */
  while ('0'<= *pfmt && *pfmt<='9') i = 10*i + (*pfmt++) - '0';
  if (*type=='A' && !i) i = 1;
  *wdth = i;

  i = 0;                                /* decode no. of digits     */
  if ((*pfmt++)!='.') return 0;
  while ('0'<= *pfmt && *pfmt<='9') i = 10*i + (*pfmt++) - '0';
  *dig = i;

  if (*type=='E' && (*wdth - *dig)<7) *fmt = 'F';

  return 0;
}

int fldis(pc,ps)
/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE       Fortran77 list directed input of string
.REMARK        The input line is modified - i.e. the terminating
	       quote in the string is replaced by a '\0' character.
.RETURN        return status - 0:OK, 1:error
---------------------------------------------------------------------*/
char          **pc;      /* IN/OUT: pointer to next character        */
char          **ps;      /* OUT: pointer to string                   */
{
  char     *pl,c;

  pl = *pc; *ps = *pc;
  while ((c = *pl++) && c!='\'' && c!='/');           /* find string */
  if (c!='\'') return 1;               /* NO string - error return   */

  *ps = pl;                            /* pointer to start of string */
  while ((c = *pl) && c!='\'') pl++;
  if (!c) { *pc = pl; return 1; }      /* wrong termination - error  */
  *pl++ = '\0';                        /* terminate string with NULL */

  while ((c = *pl) && c!=',' && c!='/') pl++;     /* find terminator */
  *pc = (c!=',') ? pl : ++pl;
  return 0;
}

int fldiv(pc,pv)
/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE       Fortran77 list directed input of numeric value
.RETURN        return status - 0:OK, 1:error
---------------------------------------------------------------------*/
char          **pc;      /* IN/OUT: pointer to next character        */
double         *pv;      /* OUT: pointer to numeric value            */
{
  char     *pl,c;
  int      i;

  pl = *pc; *pv = 0.0;
  pl += getval(pl,512,&i,pv);                /* decode numeric value */
  if (*pc && *pl!=',' && *pl!= '/' && *pl!=' ') /* wrong end - error */
     return 1;

  while ((c = *pl) && c!=',' && c!='/') pl++;     /* find terminator */
  *pc = (c!=',') ? pl : ++pl;
  return 0;
}