Commit b7d98403 authored by Uwe Schulzweida's avatar Uwe Schulzweida
Browse files

Cleanup

parent 19ff26b0
......@@ -39,11 +39,13 @@ src/cdi.inc -text
src/cdiFortran.c -text
src/cdi_error.c -text
src/cdi_limits.h -text
src/cfortran.doc -text
src/cfortran.h -text
src/config.h.in -text
src/datetime.h -text
src/dmemory.c -text
src/dmemory.h -text
src/docu -text
src/dtypes.h -text
src/error.c -text
src/error.h -text
......@@ -64,6 +66,9 @@ src/hdf_int.h -text
src/ieg.h -text
src/ieglib.c -text
src/institution.c -text
src/lock.h -text
src/make_cdilib -text
src/make_fint.c -text
src/model.c -text
src/service.h -text
src/servicelib.c -text
......
This diff is collapsed.
/*
@Function
@Title
@Prototype
@Param
@Description
@Result
@Errors
@List
@EndList
@Example
@Source
@EndSource
@EndFunction
*/
#define LOCK(lock) \
{ \
if ( lock ) \
fprintf(stderr, "lock(%s:%p) already locked\n", __FILE__, __LINE__); \
lock = 1; \
}
#define UNLOCK(lock) \
{ \
if ( ! lock ) \
fprintf(stderr, "unlock(%s:%p) not locked\n", __FILE__, __LINE__); \
while ( lock == 1 ) sleep(1); \
lock = 0; \
}
#!/bin/sh
#
# combine source code into one module
# easier to compile -- no make file needed
#
# pretty generic script -- just echos, cats and greps.
#
#
PROG=cdilib.c
echo "combining source code into one module"
echo "output is ${PROG}"
#set -x
rm -f ${PROG}
DATE=`date`
cat > ${PROG} << EOR
/* Generated automatically from $USER on $DATE */
#if defined (HAVE_CONFIG_H)
# include "config.h"
#endif
#include <stdio.h>
#include <stdlib.h>
#include <stdarg.h>
#include <string.h>
#include <ctype.h>
#include <limits.h>
#include <float.h>
#include <math.h>
#include <errno.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <fcntl.h>
#include <unistd.h>
#if ! defined (HAVE_CONFIG_H)
# define HAVE_LIBGRIB 1
# define HAVE_LIBSERVICE 1
# define HAVE_LIBEXTRA 1
# define HAVE_LIBIEG 1
#endif
EOR
c="taxis.c \
dmemory.c \
dmemory.h \
error.c \
calendar.c \
model.c \
institution.c \
table.c \
util.c \
varscan.c \
vlist.c \
vlist_var.c \
basetime.c \
servicelib.c \
extralib.c \
ieglib.c \
grid_rot.c \
grid_gme.c \
grid.c \
zaxis.c \
cdf_int.c \
hdf_int.c \
cdi_error.c \
stream_int.c \
stream.c \
stream_history.c \
stream_grb.c \
stream_srv.c \
stream_ext.c \
stream_ieg.c \
stream_cdf.c \
stream_hdf.c \
stream_var.c \
stream_record.c \
tsteps.c \
file.c \
griblib.c \
swap.c \
binary.c \
cdf.c \
hdf.c \
"
h="cdi_limits.h taxis.h error.h dtypes.h file.h grib.h service.h extra.h \
ieg.h cdi.h calendar.h \
basetime.h stream_int.h stream_grb.h datetime.h stream_cdf.h stream_hdf.h \
grib.h tablepar.h table.h util.h grid.h varscan.h binary.h swap.h \
service.h stream_srv.h stream_ext.h stream_ieg.h cdf_int.h \
hdf_int.h cdf.h hdf.h vlist.h"
cat $h >> ${PROG}
cat $c | grep -v '#include' >> ${PROG}
if test -f config.h ; then
cpp -P -DHAVE_CONFIG_H version.c >> ${PROG}
else
echo "error: missing config.h"
fi
# Fortran interface (with -DHAVE_CF_INTERFACE)
echo "#if defined (HAVE_CF_INTERFACE)" >> ${PROG}
echo "#undef realloc" >> ${PROG}
echo "#undef malloc" >> ${PROG}
echo "#undef calloc" >> ${PROG}
echo "#undef free" >> ${PROG}
echo "#undef DOUBLE_PRECISION" >> ${PROG}
cat cfortran.h >> ${PROG}
echo "#endif" >> ${PROG}
cat cdiFortran.c >> ${PROG}
echo "#undef realloc" >> ${PROG}
echo "#undef malloc" >> ${PROG}
echo "#undef calloc" >> ${PROG}
echo "#undef free" >> ${PROG}
exit
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <ctype.h>
#include "config.h"
typedef struct
{
int naline;
char *fname;
char *aline[99];
char *text;
}
Docu;
Docu cdoc[9999], fdoc[9999];
int ncdoc = 0, nfdoc = 0;
int doccmp(const void *s1, const void *s2)
{
Docu *x = (Docu *) s1;
Docu *y = (Docu *) s2;
return (strcmp(x->fname, y->fname));
}
int strcompare(const char **s1, const char **s2)
{
printf(">%s< >%s<\n", *s1, *s2);
return (strcmp(*s1, *s2));
}
void doctotex(FILE *fp, Docu *doc, int ndoc)
{
int i, k;
for ( i = 0; i < ndoc; i++ )
{
fprintf(fp, "\\section*{\\tt \\htmlref{%s}{%s}}\n\n", doc[i].fname, doc[i].fname);
fprintf(fp, "\\begin{verbatim}\n");
for ( k = 0; k < doc[i].naline; k++ )
fprintf(fp, " %s\n", doc[i].aline[k]);
fprintf(fp, "\\end{verbatim}\n");
fprintf(fp, "\n%s.\n\n\n", doc[i].text);
}
}
void doctotxt(FILE *fp, Docu *doc, int ndoc)
{
int i, k;
for ( i = 0; i < ndoc; i++ )
{
fprintf(fp, "%s\n\n", doc[i].fname);
for ( k = 0; k < doc[i].naline; k++ )
fprintf(fp, " %s\n", doc[i].aline[k]);
fprintf(fp, "\n %s.\n\n", doc[i].text);
}
}
void fortran_interface(char *fname, char *fnameinc, char *fnameint)
{
FILE *fpin, *fpinc, *fpint;
FILE *fp;
char line[1024], *pline;
char sname[128], *parname, *comment;
char xname[128], xdes[128];
int parvalue;
int functype;
int i, ii;
int lineno = 0;
size_t linelen, len;
enum {ISVOID, ISSTRING, ISSTRINGP, ISINT, ISINTP, ISREAL, ISDOUBLE, ISDOUBLEP};
char *f77name[] = {"", "CHARACTER*(*)", "CHARACTER*(*)", "INTEGER", "INTEGER", "REAL", "DOUBLEPRECISION", "DOUBLEPRECISION"};
char *cfint[] = {"", "STRING", "PSTRING", "INT", "PINT", "FLOAT", "DOUBLE", "PDOUBLE"};
char *cname[] = {"void", "char *", "char *", "int", "int *", "float", "double", "double *"};
char funcname[128];
char *funcargname[20];
int funcargtype[20];
int funcargc;
char *strsort[99999];
/*
for ( i = 0; i < 8; i++ ) strsort[i] = cname[i];
for ( i = 0; i < 8; i++ ) printf("%d %d >%s<\n", i, &strsort[i], strsort[i]);
qsort(strsort, 8, sizeof(char *), strcompare);
for ( i = 0; i < 8; i++ ) printf("%d %d >%s<\n", i, &strsort[i], strsort[i]);
return;
*/
fpin = fopen(fname, "r");
if ( fpin == NULL ) { perror(fname); return; }
fpinc = fopen(fnameinc, "w");
if ( fpinc == NULL ) { perror(fnameinc); return; }
fpint = fopen(fnameint, "w");
if ( fpint == NULL ) { perror(fnameint); return; }
/* fortran include */
fprintf(fpinc, "!\n");
fprintf(fpinc, "! Fortran interface for CDI library version %s\n", VERSION);
fprintf(fpinc, "!\n\n");
/* fortran interface */
fprintf(fpint, "#if ! defined (_CDI_H)\n");
fprintf(fpint, "# include \"cdi.h\"\n");
fprintf(fpint, "#endif\n");
fprintf(fpint, "\n");
fprintf(fpint, "#if defined (HAVE_CONFIG_H)\n");
fprintf(fpint, "# include \"config.h\"\n");
fprintf(fpint, "#endif\n");
fprintf(fpint, "\n");
fprintf(fpint, "#if defined (HAVE_CF_INTERFACE)\n");
fprintf(fpint, "\n");
fprintf(fpint, "#if ! defined (__CFORTRAN_LOADED)\n");
fprintf(fpint, "# include \"cfortran.h\"\n");
fprintf(fpint, "#endif\n");
fprintf(fpint, "\n");
while ( fgets(line, 1023, fpin) )
{
lineno++;
linelen = strlen(line);
line[linelen-1] = 0;
linelen -= 1;
functype = ISVOID;
funcargc = 0;
if ( strncmp(line, "int", 3) == 0 ||
strncmp(line, "void", 4) == 0 ||
strncmp(line, "double", 6) == 0 )
{
/* printf("%s\n", line); */
ii = 0;
for ( i = 0; i < linelen; i++ )
{
if ( isspace((int) line[i]) ) continue;
if ( line[i] == '\n' ) continue;
line[ii++] = line[i];
}
line[ii] = 0;
/* printf("%s\n", line); */
pline = line;
if ( strncmp(line, "int", 3) == 0 )
{
functype = ISINT;
pline += 3;
}
else if ( strncmp(line, "void", 4) == 0 )
{
functype = ISVOID;
pline += 4;
}
else if ( strncmp(line, "double*", 7) == 0 )
{
printf("skip: line %3d double *\n", lineno);
continue;
}
else if ( strncmp(line, "double", 6) == 0 )
{
functype = ISDOUBLE;
pline += 6;
}
else
{
printf("%s not implemented\n", line);
continue;
}
len = 0;
while ( isalnum((int) pline[len]) ) len++;
strncpy(funcname, pline, len);
funcname[len] = 0;
/* printf("%s\n", funcname);*/
pline += len;
if ( *pline != '(' )
{
printf("%s\n>(< not found!", line);
return;
}
pline++;
linelen = strlen(pline);
funcargname[funcargc] = pline;
for ( i = 0; i < linelen; i++ )
{
if ( pline[i] == ',' )
{
pline[i] = 0;
funcargc++;
funcargname[funcargc] = &pline[i+1];
}
if ( pline[i] == ')' )
{
pline[i] = 0;
funcargc++;
break;
}
}
/* printf("funcargc = %d\n", funcargc);*/
for ( i = 0; i < funcargc; i++ )
{
pline = funcargname[i];
if ( strncmp(pline, "const", 5) == 0 &&
strncmp(pline, "constchar*", 10) != 0 ) pline += 5;
if ( strncmp(pline, "void", 4) == 0 )
{
pline += 4;
funcargtype[i] = ISVOID;
funcargname[i] = pline;
}
else if ( strncmp(pline, "constchar*", 10) == 0 )
{
pline += 10;
funcargtype[i] = ISSTRING;
funcargname[i] = pline;
}
else if ( strncmp(pline, "char*", 5) == 0 )
{
pline += 5;
funcargtype[i] = ISSTRINGP;
funcargname[i] = pline;
}
else if ( strncmp(pline, "int*", 4) == 0 )
{
pline += 4;
funcargtype[i] = ISINTP;
funcargname[i] = pline;
}
else if ( strncmp(pline, "int", 3) == 0 )
{
pline += 3;
funcargtype[i] = ISINT;
funcargname[i] = pline;
}
else if ( strncmp(pline, "double*", 7) == 0 )
{
pline += 7;
funcargtype[i] = ISDOUBLEP;
funcargname[i] = pline;
}
else if ( strncmp(pline, "double", 6) == 0 )
{
pline += 6;
funcargtype[i] = ISDOUBLE;
funcargname[i] = pline;
}
else
{
printf("%s not implemented\n", funcargname[i]);
break;
}
}
if ( i != funcargc ) continue;
strcpy(sname, funcname);
len = strlen(sname);
/*
ii = 0;
for ( i = 0; i < len; i++ )
{
if ( isupper((int) sname[i]) ) break;
if ( islower((int) sname[i]) ) sname[i] = toupper((int) sname[i]);
}
sname[len+1] = 0;
for ( ii = len; ii > i; ii-- )
{
sname[ii] = sname[ii-1];
}
sname[i] = '_';
len++;
*/
/* fortran include */
if ( functype == ISVOID )
fprintf(fpinc, "! %-16s", "");
else
fprintf(fpinc, " %-16s", f77name[functype]);
fprintf(fpinc, "%s", sname);
fprintf(fpinc, "\n");
if ( (funcargc == 1 && funcargtype[0] == ISVOID) ) funcargc = 0;
for ( i = 0; i < funcargc; i++ )
{
if ( i == 0 )
fprintf(fpinc, "!%36s(", "");
else
fprintf(fpinc, ",\n!%36s ", "");
fprintf(fpinc, "%-16s%s", f77name[funcargtype[i]], funcargname[i]);
}
if ( funcargc )
fprintf(fpinc, ")\n");
fprintf(fpinc, " %-16s%s\n\n", "EXTERNAL", sname);
/* fortran interface */
if ( functype == ISVOID )
fprintf(fpint, "FCALLSCSUB");
else
fprintf(fpint, "FCALLSCFUN");
fprintf(fpint, "%d ", funcargc);
fprintf(fpint, "(");
if ( functype != ISVOID )
fprintf(fpint, "%s, ", cfint[functype]);
fprintf(fpint, "%s, ", funcname);
for ( i = 0; i < len; i++ ) sname[i] = toupper((int) sname[i]);
fprintf(fpint, "%s, ", sname);
for ( i = 0; i < len; i++ ) sname[i] = tolower((int) sname[i]);
fprintf(fpint, "%s", sname);
for ( i = 0; i < funcargc; i++ )
{
fprintf(fpint, ", %s", cfint[funcargtype[i]]);
}
fprintf(fpint, ")\n");
if ( strcmp(funcname, xname) == 0 )
{
char xline[128];
char farg[128];
int nch, ncha = 0, nchn;
/* C Quick Guide */
cdoc[ncdoc].naline = 0;
cdoc[ncdoc].text = NULL;
cdoc[ncdoc].fname = strdup(funcname);
nch = sprintf(xline, "%s %s (", cname[functype], xname);
if ( (funcargc == 1 && funcargtype[0] == ISVOID) ) funcargc = 0;
for ( i = 0; i < funcargc; i++ )
{
if ( i ) strcat(xline, ", ");
nchn = sprintf(farg, "%s%s", cname[funcargtype[i]], funcargname[i]);
if ( (strlen(xline)+nchn) > 80 )
{
cdoc[ncdoc].aline[cdoc[ncdoc].naline++] = strdup(xline);
sprintf(xline, "%*s", nch, "");
}
strcat(xline, farg);
}
if ( funcargc ) strcat(xline, ");");
cdoc[ncdoc].aline[cdoc[ncdoc].naline++] = strdup(xline);
cdoc[ncdoc].text = strdup(xdes);
ncdoc++;
/* Fortran Quick Guide */
ncha = 0;
fdoc[nfdoc].naline = 0;
fdoc[nfdoc].text = NULL;
fdoc[nfdoc].fname = strdup(funcname);
if ( functype == ISVOID )
nch = sprintf(xline, "SUBROUTINE %s (", xname);
else
nch = sprintf(xline, "%s FUNCTION %s (", f77name[functype], xname);
if ( (funcargc == 1 && funcargtype[0] == ISVOID) ) funcargc = 0;
for ( i = 0; i < funcargc; i++ )
{
if ( i ) strcat(xline, ", ");
nchn = sprintf(farg, "%s %s", f77name[funcargtype[i]], funcargname[i]);
if ( (strlen(xline)+nchn) > 80 )
{
fdoc[nfdoc].aline[fdoc[nfdoc].naline++] = strdup(xline);
sprintf(xline, "%*s", nch, "");
}
strcat(xline, farg);
}
if ( funcargc ) strcat(xline, ")");
fdoc[nfdoc].aline[fdoc[nfdoc].naline++] = strdup(xline);
fdoc[nfdoc].text = strdup(xdes);
nfdoc++;
}
}
else if ( strncmp(line, "#define", 7) == 0 )
{
pline = line;
pline += 7;
while ( isspace((int) *pline) ) pline++;
parname = pline;
len = strlen(pline);
for ( i = 0; i < len; i++ )
{
if ( isspace((int) pline[i]) ) break;
}
if ( i == len ) continue;
parname[i] = 0;
pline += i+1;
while ( isspace((int) *pline) ) pline++;
if ( ! (isdigit((int) *pline) || *pline == '-') ) continue;
parvalue = atoi(pline);
/* fortran include */
fprintf(fpinc, " INTEGER %-22s\n", parname);
fprintf(fpinc, " PARAMETER (%-22s = %2d)\n", parname, parvalue);
}
else if ( strncmp(line, "/*", 2) == 0 )
{
int dpos = 0;
pline = line;
pline += 2;
while ( isspace((int) *pline) ) pline++;
comment = pline;
len = strlen(pline);
if ( len == 0 ) continue;
for ( i = len-1; i > 0; i-- )
if ( pline[i-1] == '*' && pline[i] == '/' ) break;
if ( i == 0 ) continue;
pline[i-1] = 0;
len -= 2;
for ( i = len-1; i > 0; i-- )
if ( pline[i] != ' ' ) break;
pline[i+1] = 0;