cforthdf.h

GIS系统支持库Geospatial Data Abstraction Library代码.GDAL is a translator library for raster geospatial dat

/*
Copyright (C) 1996 Hughes and Applied Research Corporation

Permission to use, modify, and distribute this software and its documentation 
for any purpose without fee is hereby granted, provided that the above 
copyright notice appear in all copies and that both that copyright notice and 
this permission notice appear in supporting documentation.
*/


/* cfortran.h */ /* 2.8 */            /* anonymous ftp: zebra.desy.de */
/* Burkhard Burow, [e-mail], University of Toronto, 1993. */


#ifndef __CFORTRAN_LOADED
#define __CFORTRAN_LOADED

/* 
   THIS FILE IS PROPERTY OF BURKHARD BUROW. IF YOU ARE USING THIS FILE YOU
   SHOULD ALSO HAVE ACCESS TO CFORTRAN.DOC WHICH PROVIDES TERMS FOR USING,
   MODIFYING, COPYING AND DISTRIBUTING THE CFORTRAN.H PACKAGE.
*/

/* Before using cfortran.h on CRAY, RS/6000, Apollo >=6.8, gcc -ansi,
   or any other ANSI C compiler, you must once do:
prompt> mv cfortran.h cf_temp.h && sed 's/\/\*\*\//\#\#/g' cf_temp.h >cfortran.h
   i.e. we change the ' / * * / ' kludge to # #. */

/* First prepare for the C compiler. */

#if (defined(vax)&&defined(unix)) || (defined(__vax__)&&defined(__unix__))
#define VAXUltrix
#endif

#include <stdio.h>     /* NULL [in all machines stdio.h]                      */
#include <string.h>    /* strlen, memset, memcpy, memchr.                     */
#if !( defined(VAXUltrix) || defined(sun) || (defined(apollo)&&!defined(__STDCPP__)) )
#include <stdlib.h>    /* malloc,free                                         */
#else
#include <malloc.h>    
#ifdef apollo
#define __CF__APOLLO67 /* __STDCPP__ is in Apollo 6.8 (i.e. ANSI) and onwards */
#endif
#endif

#if (!defined(__GNUC__) && (defined(sun)||defined(VAXUltrix)||defined(lynx)))
#define __CF__KnR     /* Sun, LynxOS and VAX Ultrix cc only supports K&R.     */
                      /* Manually define __CF__KnR for HP if desired/required.*/
#endif                /*       i.e. We will generate Kernighan and Ritchie C. */
/* Note that you may define __CF__KnR before #include cfortran.h, in order to
generate K&R C instead of the default ANSI C. The differences are mainly in the
function prototypes and declarations. All machines, except the Apollo, work
with either style. The Apollo's argument promotion rules require ANSI or use of
the obsolete std_$call which we have not implemented here. Hence on the Apollo,
only C calling FORTRAN subroutines will work using K&R style.*/


/* Remainder of cfortran.h depends on the Fortran compiler. */

/* VAX/VMS does not let us \-split these long lines. */ 
#if !(defined(NAGf90Fortran)||defined(f2cFortran)||defined(hpuxFortran)||defined(apolloFortran)||defined(sunFortran)||defined(IBMR2Fortran)||defined(CRAYFortran)||defined(mipsFortran)||defined(DECFortran)||defined(vmsFortran))
/* If no Fortran compiler is given, we choose one for the machines we know.   */
#if defined(lynx) || defined(VAXUltrix)
#define f2cFortran    /* Lynx:      Only support f2c at the moment.
                         VAXUltrix: f77 behaves like f2c.
                           Support f2c or f77 with gcc, vcc with f2c. 
                           f77 with vcc works, missing link magic for f77 I/O.*/
#endif
#if defined(__hpux)       /* 921107: Use __hpux instead of __hp9000s300 */
#define       hpuxFortran /*         Should also allow hp9000s7/800 use.*/
#endif
#if       defined(apollo)
#define           apolloFortran  /* __CF__APOLLO67 defines some behavior. */
#endif
#if          defined(sun)
#define              sunFortran
#endif
#if       defined(_IBMR2)
#define            IBMR2Fortran
#endif
#if        defined(_CRAY)
#define             CRAYFortran  /* _CRAY2         defines some behavior. */
#endif
#if         defined(mips) || defined(__mips)
#define             mipsFortran
#endif
#if          defined(vms) || defined(__vms)
#define              vmsFortran
#endif
#if      defined(__alpha) && defined(__unix__)
#define              DECFortran
#endif
#endif /* ...Fortran */



#if defined(VAXC) && !defined(__VAXC)
#define OLD_VAXC
#pragma nostandard                       /* Prevent %CC-I-PARAMNOTUSED.       */
#endif

/* Throughout cfortran.h we use: UN = Uppercase Name.  LN = Lowercase Name.  */

#if defined(f2cFortran) || defined(NAGf90Fortran) || defined(DECFortran) || defined(mipsFortran) || defined(apolloFortran) || defined(sunFortran) || defined(extname)
#if defined(f2cFortran)
#define CFC_(UN,LN)            LN##_  /* Lowercase FORTRAN symbols.        */
#else
#define CFC_(UN,LN)            LN##_   /* Lowercase FORTRAN symbols.        */
#endif   /* f2cFortran */
#define orig_fcallsc           CFC_
#else 
#ifdef CRAYFortran
#define CFC_(UN,LN)            UN        /* Uppercase FORTRAN symbols.        */
#define orig_fcallsc(UN,LN)    CFC_(UN,LN)  /* CRAY insists on arg.'s here.   */
#else  /* For following machines one may wish to change the fcallsc default.  */
#define CF_SAME_NAMESPACE
#ifdef vmsFortran
#define CFC_(UN,LN)            LN        /* Either case FORTRAN symbols.      */
     /* BUT we usually use UN for C macro to FORTRAN routines, so use LN here,*/
     /* because VAX/VMS doesn't do recursive macros.                          */
#define orig_fcallsc(UN,LN)    UN      
#else      /* HP-UX without +ppu or IBMR2 without -qextname. NOT reccomended. */
#define CFC_(UN,LN)            LN        /* Lowercase FORTRAN symbols.        */
#define orig_fcallsc           CFC_
#endif /*  vmsFortran */
#endif /* CRAYFortran */
#endif /* ....Fortran */

#define fcallsc                      orig_fcallsc
#define preface_fcallsc(P,p,UN,LN)   CFC_(P##UN,p##LN)
#define  append_fcallsc(P,p,UN,LN)   CFC_(UN##P,LN##p)

#define C_FUNCTION                   fcallsc      
#define FORTRAN_FUNCTION             CFC_
#define COMMON_BLOCK                 CFC_

#if defined(NAGf90Fortran) || defined(f2cFortran) || defined(mipsFortran)
#define LOGICAL_STRICT      /* These have .eqv./.neqv. == .eq./.ne.   */
#endif

#ifdef CRAYFortran
#if _CRAY
#include <fortran.h>
#else
#include "fortran.h"  /* i.e. if crosscompiling assume user has file. */
#endif
#define DOUBLE_PRECISION long double
#define PPFLOATVVVVVVV (float *)   /* Used for C calls FORTRAN.               */
/* CRAY's double==float but CRAY says pointers to doubles and floats are diff.*/
#define VOIDP0  (void *)  /* When FORTRAN calls C, we don't know if C routine 
                            arg.'s have been declared float *, or double *.   */
#else
#define DOUBLE_PRECISION double
#define PPFLOATVVVVVVV
#define VOIDP0
#endif

#ifdef vmsFortran
#if    defined(vms) || defined(__vms)
#include <descrip.h>
#else
#include "descrip.h"  /* i.e. if crosscompiling assume user has file. */
#endif
#endif

#ifdef sunFortran
#if    sun
#include <math.h>     /* Sun's FLOATFUNCTIONTYPE, ASSIGNFLOAT, RETURNFLOAT.  */
#else
#include "math.h"     /* i.e. if crosscompiling assume user has file. */
#endif
#endif

#ifdef __cplusplus
extern "C" {
#endif

#ifndef apolloFortran
#define COMMON_BLOCK_DEF(DEFINITION, NAME) extern DEFINITION NAME
#define CF_NULL_PROTO
#else                                         /* HP doesn't understand #elif. */
/* Without ANSI prototyping, Apollo promotes float functions to double.    */
/* Note that VAX/VMS, IBM, Mips choke on 'type function(...);' prototypes. */
#define CF_NULL_PROTO ...
#ifndef __CF__APOLLO67
#define COMMON_BLOCK_DEF(DEFINITION, NAME) \
 DEFINITION NAME __attribute((__section(NAME)))
#else
#define COMMON_BLOCK_DEF(DEFINITION, NAME) \
 DEFINITION NAME #attribute[section(NAME)]
#endif
#endif

#ifdef mipsFortran
#define CF_DECLARE_GETARG         int f77argc; char **f77argv
#define CF_SET_GETARG(ARGC,ARGV)  f77argc = ARGC; f77argv = ARGV
#else
#define CF_DECLARE_GETARG
#define CF_SET_GETARG(ARGC,ARGV)
#endif

#ifdef OLD_VAXC                          /* Allow %CC-I-PARAMNOTUSED.         */
#pragma standard                         
#endif

#define ACOMMA ,
#define ACOLON ;

/*-------------------------------------------------------------------------*/

/*               UTILITIES USED WITHIN CFORTRAN.H                          */

#define PGSMIN(A,B) (A<B?A:B)
#define firstindexlength( A) (sizeof(A)     /sizeof(A[0]))
#define secondindexlength(A) (sizeof((A)[0])/sizeof((A)[0][0]))
#ifndef FALSE
#define FALSE (1==0)
#endif

/* Behavior of FORTRAN LOGICAL. All machines' LOGICAL is same size as C's int.
Conversion is automatic except for arrays which require F2CLOGICALV/C2FLOGICALV.
f2c, MIPS f77 [DECstation, SGI], VAX Ultrix f77, CRAY-2, HP-UX f77:  as in C.
VAX/VMS FORTRAN, VAX Ultrix fort, IBM RS/6000 xlf: LS Bit = 0/1 = TRUE/FALSE.
Apollo, non CRAY-2                               : neg.   = TRUE, else FALSE. 
[Apollo accepts -1 as TRUE for function values, but NOT all other neg. values.]
[DECFortran for Ultrix RISC is also called f77 but is the same as VAX/VMS.]   
[MIPS f77 treats .eqv./.neqv. as .eq./.ne. and hence requires LOGICAL_STRICT.]*/

#define C2FLOGICALV(A,I) \
 do {int __i; for(__i=0;__i<I;__i++) A[__i]=C2FLOGICAL(A[__i]); } while (FALSE)
#define F2CLOGICALV(A,I) \
 do {int __i; for(__i=0;__i<I;__i++) A[__i]=F2CLOGICAL(A[__i]); } while (FALSE)

#if defined(apolloFortran) || (defined(CRAYFortran) && !defined(_CRAY2))
#ifndef apolloFortran
#define C2FLOGICAL(L) ((L)?(L)|(1<<sizeof(int)*8-1):(L)&~(1<<sizeof(int)*8-1))
#else
#define C2FLOGICAL(L) ((L)?-1:(L)&~(1<<sizeof(int)*8-1)) /* Apollo Exception  */
#endif
#define F2CLOGICAL(L) ((L)<0?(L):0) 
#else
#if defined(IBMR2Fortran) || defined(vmsFortran) || defined(DECFortran)
#define C2FLOGICAL(L) ((L)?(L)|1:(L)&~(int)1)
#define F2CLOGICAL(L) ((L)&1?(L):0)
#else /* all other machines evaluate LOGICALs as C does. */
#define C2FLOGICAL(L) (L)
#define F2CLOGICAL(L) (L)
#ifndef LOGICAL_STRICT
#undef  C2FLOGICALV
#undef  F2CLOGICALV
#define C2FLOGICALV(A,I)
#define F2CLOGICALV(A,I)
#endif  /* LOGICAL_STRICT */
#endif
#endif

#ifdef LOGICAL_STRICT
/* Force C2FLOGICAL to generate only the values for either .TRUE. or .FALSE.
   This is only needed if you want to do:
     logical lvariable
     if (lvariable .eq.  .true.) then       ! (1)
   instead of
     if (lvariable .eqv. .true.) then       ! (2)
   - (1) may not even be FORTRAN/77 and that Apollo's f77 and IBM's xlf
   refuse to compile (1), so you are probably well advised to stay away from 
   (1) and from LOGICAL_STRICT.
   - You pay a (slight) performance penalty for using LOGICAL_STRICT. */
#undef C2FLOGICAL
#if defined(apolloFortran) || (defined(CRAYFortran) && !defined(_CRAY2)) || defined(vmsFortran) || defined(DECFortran)
#define C2FLOGICAL(L) ((L)?-1:0) /* These machines use -1/0 for .true./.false.*/
#else
#define C2FLOGICAL(L) ((L)? 1:0) /* All others     use +1/0 for .true./.false.*/
#endif
#endif /* LOGICAL_STRICT */

/* Convert a vector of C strings into FORTRAN strings. */
#ifndef __CF__KnR
static char *c2fstrv(char* cstr, char *fstr, int elem_len, int sizeofcstr)
#else
static char *c2fstrv(      cstr,       fstr,     elem_len,     sizeofcstr)