1
/*===========================================================================
2
Copyright (C) 1995-2005 European Southern Observatory (ESO)
4
This program is free software; you can redistribute it and/or
5
modify it under the terms of the GNU General Public License as
6
published by the Free Software Foundation; either version 2 of
7
the License, or (at your option) any later version.
9
This program is distributed in the hope that it will be useful,
10
but WITHOUT ANY WARRANTY; without even the implied warranty of
11
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12
GNU General Public License for more details.
14
You should have received a copy of the GNU General Public
15
License along with this program; if not, write to the Free
16
Software Foundation, Inc., 675 Massachusetts Ave, Cambridge,
19
Correspondence concerning ESO-MIDAS should be addressed as follows:
20
Internet e-mail: midas@eso.org
21
Postal address: European Southern Observatory
22
Data Management Division
23
Karl-Schwarzschild-Strasse 2
24
D 85748 Garching bei Muenchen
26
===========================================================================*/
28
/*+++++++++ Remove ESO extensions to FORTRAN 77 ++++++++++++++++++++
29
.COPYRIGHT (c) 1988-2005 European Southern Observatory
32
.AUTHOR Preben J. Grosbol [ESO/IPG]
33
.KEYWORDS identifier table
36
.VERSION 1.0 2-Nov-1987: Creation, PJG
37
.VERSION 1.1 23-Mar-1988: Cast arg. of isdigit etc as int, PJG
40
------------------------------------------------------------------------*/
41
#include <stdio.h> /* standard I/O functions */
42
#include <ctype.h> /* character types */
43
#include <f77ext.h> /* definition of constants */
44
#include <f77stat.h> /* f77 statements */
46
extern int no_lid; /* no. of line identifiers */
47
extern LID lid[]; /* list of line identifiers */
49
static char *list[] = /* logical exp. and const. */
50
{"EQ","NE","AND","OR","NOT","LT","LE","GT","GE",
51
"EQV","NEQV","TRUE","FALSE",(char *)0 };
53
void chk_io(plid) /* check identifiers in I/O statement */
59
for (n=0; n<no_lid; n++, plid++) { /* go through all identiifers */
60
if (!plid->size || !plid->level) continue;
61
pc = plid->sid + plid->size + 1;
62
if (*pc == '=') plid->size = 0;
67
void chk_exp(plid) /* check identifiers in expression */
73
plid++; /* skip first identifier */
74
for (n=1; n<no_lid; n++, plid++) { /* check all the rest */
75
if (!plid->size) continue;
77
if (*(--pc) == '.') { /* maybe logical or exponent */
79
do { /* compare with logicals */
81
while (*pc == *pl) { pc++; pl++; }
82
if (!(*pl) && *pc == '.') { /* it is a logical constant */
83
plid->size = 0; break;
85
} while ((pl = list[i++]));
87
if (*pc == 'E' || *pc == 'D') { /* test if exponent */
88
pc -= 2; if (isdigit((int)*pc)) plid->size = 0;
91
else if (isdigit((int)*pc)) plid->size = 0;