[comp.os.vms] C<->FORTRAN made easy.

burow@cernvax.cern.ch (burkhard burow) (05/17/91)

This posting is the latest release of CFORTRAN. It makes C<->FORTRAN easy.

The application interface has not changed. The internals have been improved.

IBM RS/6000 - The Mips version works, we now call this the unix version.
            - Q: Is there a predefined macro to id the RS/6000?

VMS - The string handling machinery has been simplified and now parallels the
      unix version very closely.
    - LIB$.... from C will never be easier. descrip.h will no longer haunt you.
    - %CC-I-PARAMNOTUSED is the only reason a separate cfortran.h file has to
      exist for VMS. Any chance for a #pragma to turn this thing off?

Sun - The unix version should run out of the box on any near ANSI compiler. 
      Unfortunately the SPARCstation I found had only K&R I C, so I couldn't 
      try it out.


CERN, the European High Energy Physics Lab, has announced that it would like to
release its FORTRAN Program Library to C users via CFORTRAN. So CFORTRAN may
someday soon be well supported. If you've got nothing to do on Sunday, and
you'd like to sharpen your preprocessing skills and own/have an account(s) on

Apollo SR10, HP 9000, Cray, IBM mainframe, Convex, Next, ....

machines, cfortran.h makes an interesting 'easy' port. Or if you wait a while,
CFORTRAN will make its way to you. [Funny how it's easier for me to get
accounts on these machines than it is to get a FORTRAN manual for them. :-)]

Appended is cfortran.doc, cfortran_unix.h, cfortran_vms.h, cfortest.c,
cfortex.for.

tschuess,
burkhard
--------------cut for cfortran.doc----------------------------------
/* cfortran.doc */
/* Burkhard Burow, burow@vxdesy.desy.de, U. of Toronto, 1991. */


                CFORTRAN 1.2 for UNIX Machines and for VAX VMS

History:
- 1.0 for VAX VMS using C 3.1 and FORTRAN 5.4.                        Oct. '90.
- 1.0 for Silicon Graphics using Mips Computer System 2.0 f77 and cc. Feb. '91.
          [Port of C calls FORTRAN half only.]
- 1.1 for Mips Computer System 2.0 f77 and cc.                        Mar. '91.
          [Runs on at least: Silicon Graphics IRIX 3.3.1
                             DECstations with Ultrix V4.1]
- 1.2 Internals are simpler, smaller, faster, stronger.               May  '91.
      Mips version works on IBM RS/6000, this is now called the unix version.
                      

I Introduction
--------------

CFORTRAN is an easy-to-use powerful bridge between C and FORTRAN. It provides a
completely transparent, machine independant, interface  between C and FORTRAN
routines (= subroutines and/or functions). 

The complete CFORTRAN package consists of 4 files. They are this introduction,
cfortran.doc, the engine in cfortran.h, examples in cfortest.c and 
cfortex.f/or. [cfortex.for under VMS, cfortex.f under UNIX.]
Note that there exist 2 versions of cfortran.h:
   cfortran_vms.h   -  for VAX VMS
   cfortran_unix.h  -  for UNIX Machines
The appropriate one of these two files will have to be renamed to cfortran.h in
order for CFORTRAN to work on your system.

To run the example do the following:

RS/6000> mv cfortran_unix.h cfortran.h
RS/6000> cc -Drs6000 -c cfortest.c && xlf -o cfortest cfortest.o cfortex.f
RS/6000> cfortest

or

MIPS> mv cfortran_unix.h cfortran.h
MIPS> cc -o cfortest cfortest.c cfortex.f -lI77 -lU77 -lF77
MIPS> cfortest

or

VMS> rena cfortran_vms.h cfortran.h
VMS> define lnk$library sys$library:vaxcrtl
VMS> cc cfortest.c
VMS> fortran cfortex.for
VMS> link/exec=cfortest cfortest,cfortex
VMS> run cfortest

By changing the SELECTion ifdef of cfortest.c and recompiling you can try out
a dozen different few-line examples.



The benefits of using CFORTRAN include:
1. Machine independant applications.

2. Identical (within syntax) calls across languages, e.g.
C FORTRAN
      CALL HBOOK1(1,'pT spectrum of pi+',100,0.,5.,0.)
/* C*/
           HBOOK1(1,"pT spectrum of pi+",100,0.,5.,0.);

3. Each routine need ony be set up once in its lifetime. e.g.
/* Setting up a FORTRAN routine to be called by C. Note that ID,...,VMX are
merely the names of arguments. These tags must be unique w.r.t. each other but 
are arbitrary. */
PROTOCCALLSFSUB6(hbook1,INT,STRING,INT,FLOAT,FLOAT,FLOAT)
#define HBOOK1(ID,CHTITLE,NX,XMI,XMA,VMX)                 \
     CCALLSFSUB6(hbook1,INT,STRING,INT,FLOAT,FLOAT,FLOAT, \
               ID,CHTITLE,NX,XMI,XMA,VMX) 

4. Routines, and the code calling them, can be coded naturally in the language
   of choice. C routines may be coded with the natural assumption that they'll
   only be called by C code. CFORTRAN does all the required work for FORTRAN 
   code to call C routines. Similarly CFORTRAN does all the work required for C
   to call FORTRAN routines. Therefore:
     - C programmers need not imbed FORTRAN argument passing mechanisms into 
       their code.
     - FORTRAN code need not be converted into C code. i.e. The honed and 
       timehonored FORTRAN routines are called by C, not some new translation 
       from FORTRAN into C.

5. CFORTRAN is contained within a single C include file, cfortran.h, weighing
   in at less than 900 lines. 
   cfortran.h IS machine/compiler dependant, versions for VAX VMS and for the
   UNIX machines, IBM RS/6000 and those using MIPS RISC, currently exist. The
   UNIX version is probably easily ported to many other UNIX platforms.

6. STRINGS and VECTORS of STRINGS along with the usual simple arguments to 
   routines are supported as are functions returning STRINGS or numbers.

7. CFORTRAN requires each routine to be exported to be explicitly set up. While
   this need usually only be done once in a header file it would be best if 
   applications were required to do no work at all in order to cross languages.
   CFORTRAN's simple syntax could be a convinient back-end for a program which
   would export FORTRAN or C routines directly from the source code. 


                                    -----

Example 1 - CFORTRAN has been used to make the C header file hbook.h, 
            which then gives any C programmer, e.g. example.c, full and 
            completely transparent access to CERN's HBOOK library of routines.
            Each HBOOK routine required about 3 lines of simple code in
            hbook.h. The example also demonstrates how FORTRAN common blocks
            are defined and used.

/* hbook.h */
#include "cfortran.h"
        :
PROTOCCALLSFSUB6(hbook1,INT,STRING,INT,FLOAT,FLOAT,FLOAT)
#define HBOOK1(ID,CHTITLE,NX,XMI,XMA,VMX) \
     CCALLSFSUB6(hbook1,INT,STRING,INT,FLOAT,FLOAT,FLOAT, \
               ID,CHTITLE,NX,XMI,XMA,VMX) 
        :
/* end hbook.h */

/* example.c */
#include "hbook.h"
        :
typedef struct {
  int lines;  
  int status[SIZE];
  float p[SIZE];  /* momentum */
} FAKE_DEF;
#define FAKE COMMON_BLOCK(fake)
extern FAKE_DEF FAKE;
        :
main ()
{
        :
           HBOOK1(1,"pT spectrum of pi+",100,0.,5.,0.);
/* c.f. the call in FORTRAN:
      CALL HBOOK1(1,'pT spectrum of pi+',100,0.,5.,0.)
*/
        :
  FAKE.p[7]=1.0;
	:
}           

N.B. i) The routine is language independant.
    ii) hbook.h is machine independant.  
   iii) Applications using CFORTRAN'd routines are machine independant.

                                    -----

Example 2 - Many VMS System calls are most easily called from FORTRAN, but
            CFORTRAN now gives you that ease in C.

#include "cfortran.h"

PROTOCCALLSFSUB3(lib$spawn, STRING, STRING, STRING)
#define LIB$SPAWN(command, input_file, output_file) \
 CCALLSFSUB3(lib$spawn, STRING, STRING, STRING, command, input_file, output)

main ()
{
LIB$SPAWN("set term/width=132", NULL, NULL);
}

Obviously the 3 CFORTRAN lines above should be put into a header file along
with the description of the other system calls, but as this example shows it's
not much hassle to set up CFORTRAN for even a single call.

                                    -----

Example 3 - CFORTRAN and the source cstring.c create the cstring.obj library 
            which gives FORTRAN access to all the functions in C's system 
            library described by the system's C header file string.h.

C     EXAMPLE.FOR
      PROGRAM EXAMPLE
      DIMENSION I(20), J(30)
        :
      CMEMCPY(I,J,7)
        :
      END

/* cstring.c */
#include <string.h>
#include "cfortran.h"

#undef fcallsc
#define fcallsc(NAME) C/**/NAME

        :
FCALLSCSUB3(memcpy, PVOID, PVOID, INT)
        :

N.B. Other than a possible redefinition of fcallsc, cstring.c is machine
independant. Unfortunately the names of C routines called by FORTRAN may
differ from  the name of the original C routine, e.g. cmemcpy vs. the original
memcpy. This need never be the case if one has:

   i) the original C source code for the routine. 
OR ii)a FORTRAN compiler, e.g. f77, which 'renames' routines. 
OR iii) a case sensitive linker.

If all the above fail, CFORTRAN, through fcallsc, makes it easy to ensure that
names of C routines called by FORTRAN are modified from  the original only when
absolutely neccessary, and if they are modified, that it is done consistently
for any given FORTRAN compiler. [More details below in Section VI.]

                                    -----


II Using CFORTRAN
-----------------

The user is asked to look at the source files CFORTEX.C and CFORTEX.FOR for
clarification by example.

Note: CFORTRAN (ab)uses the null comment, /**/, kludge for the ANSI C
preprocessor concatenation, ##, operator. In MIPS C this kludge is sensitive
to blanks prepending arguments to macros.
THEREFORE IN THE FOLLOWING MACRO DEFINITIONS YOU MAY NOT PREPEND argtype_i NOR
routine_type WITH BLANK, ' ', CHARACTERS.

Note: On the RS/6000 a global replace of /**/ by ## makes cfortran.h ANSI
compliant.

Note: At the moment only vectors of fixed length strings are supported in C. I
know how and hope to support vectors of pointers to strings in the near future.

Note: For those who wish to use CFORTRAN in large applications.
This release is intended to make it easy to get applications up and running. 
This implies that applications are not as efficient as they could be:
- The current mechanism is inefficient if a single header file is used to
  describe a large library of FORTRAN functions. Code for a static wrapper fn.
  is generated in each piece of C source code for each FORTRAN function 
  specified with the CCALLSFFUNn statement, irrespective of whether or not the
  function is ever called. I have several ideas for how code for these wrappers
  could be created, compiled and linked only once instead of once for each
  piece of source code. 
- Code for several static utility routines internal to CFORTRAN is placed into
  any source code which #include's cfortran.h. These routines should be in a
  library.
- The FORTRAN calls C half of the package could be split from the C calls
  FORTRAN half.


i) Calling FORTRAN routines from C:

FORTRAN common blocks are set up with the following construct:

#define COMMON_BLOCK_NAME COMMON_BLOCK(common_block_name)

where common_block_name is given in the case shown. This construct exists to
ensure that C code accessing the common block is machine independant.


FORTRAN routines are prototyped by the following two macros.

PROTOCCALLSFSUBn(routine_name, argtype_1, ..., argtype_n)

or

PROTOCCALLSFFUNn(routine_type, routine_name, argtype_1, ..., argtype_n)


and are defined respectively by the following two macro usages.

#define      ROUTINE_NAME(argname_1,...,argname_n) \
CCALLSFSUBn(routine_name, argtype_1,...,argtype_n, \
                          argname_1,...,argname_n) 

#define      ROUTINE_NAME(argname_1,...,argname_n) \
CCALLSFFUNn(routine_name, argtype_1,...,argtype_n, \
                          argname_1,...,argname_n) 

Where:
'n' = 0->7 (easily expanded in CFORTRAN.H to >7) stands for the number of 
    arguments to the routine.
ROUTINE_NAME = the C       name of the routine (IN UPPERCASE LETTERS).
routine_name = the FORTRAN name of the routine (IN lowercase LETTERS).
routine_type = the type of argument returned by FORTRAN functions.
             = DOUBLE, FLOAT, INT, LOGICAL, LONG, STRING.
argtype_i    = the type of argument passed to the FORTRAN routine and must be
               consistent in the definition and prototyping of the routine s.a.
             = DOUBLE, FLOAT, INT, LOGICAL, LONG, STRING.
             For vectors, i.e. 1 dim. arrays use 
             = DOUBLEV, FLOATV, INTV, LOGICALV, LONGV.
             For vectors of vectors, 2 dim. arrays use
             = DOUBLEVV, FLOATVV, INTVV, LOGICALVV, LONGVV, STRINGV.
             For n-dim. arrays use
             = DOUBLEV..nV's..V, FLOATV..V, INTV..V, LOGICALV..V, LONGV..V.
                N.B. Array dimensions and types are checked by the C compiler.
             For routines changing the values of an argument, the keyword is 
                  prepended by a 'P'.
             = PDOUBLE, PFLOAT, PINT, PLOGICAL, PLONG, PSTRING, PSTRINGV.
             For exceptional arguments which require no massaging to fit the
                  argument passing mechanisms use:
             = PVOID.
                This is most useful for passing functions as arguments.
                But note that although PVOID could be used to describe all
                array arguments on most (all?) machines , it shouldn't be
                because the C compiler can no longer check the type and 
                dimension of the array.
argname_i    = any valid unique C tag, but must be consistent in the definition 
               as shown.

Some notes on (P)STRING(V):

STRING - If the argument is a fixed length character array, e.g. char ar[8];,
the string is blank, ' ', padded on the right to fill out the array before
being passed to the FORTRAN routine. The useful size of the string is the same
in both languages, e.g. we pass ar[8] as character*7. If the argument is a
pointer, we cannot blank pad, and pass the length as strlen(argument). On
return from the FORTRAN routine, pointer arguments are not disturbed, arrays
have the terminating '\0' replaced to its original position. i.e. The
padding blanks are never visible to the C code.

PSTRING - The argument is massaged as with STRING before being passed to the
FORTRAN routine. On return, the argument has all trailing blanks removed,
regardless of whether the argument was a pointer or an array.

N.B. Only char arrays are supported for (P)STRINGV. e.g. char bb[6][8];

STRINGV - The elements of the argument are copied into space malloc'd, and each
element is padded with blanks. The useful size of each element is the same in 
both languages. Therefore char bb[6][8]; is equivalent to character*7 bb(6).
On return from the routine the malloc'd space is simply released.

PSTRINGV - Since FORTRAN has no trailing '\0', elements in an array of strings
are contiguous. Therefore we pad each element of the C array with blanks and
strip out C's trailing '\0'. After returning from the routine, we reinsert the
trailing '\0' and kill the trailing blanks in each element.

Summary: STRING(V) arguments are blank padded during the call to the FORTRAN
routine, but remain original in the C code. (P)STRINGV arguments are blank
padded for the FORTRAN call, and after returning from FORTRAN trailing blanks
are stripped off.


PVOID, as noted above, is used to declare that a function will be passed as an
argument. In order to perform the call, CFORTRAN must know the language of the
function to be passed, therefore the when passing C functions to FORTRAN
routines use:

    FORTRAN_ROUTINE( ...., C_FUNCTION(some_function), ...)

and similarly when passing a FORTRAN routine:

    FORTRAN_ROUTINE( ...., FORTRAN_FUNCTION(some_function), ...)


This list of argument types is not neccessarily complete. CFORTRAN may be
expanded to handle a new type not among the above.

N.B. The FORTRAN routines are called using macro expansions, therefore the
usual caveats for expressions in arguments apply. The expressions to the
routines may be evaluated more than once, leading to lower performance and in
the worst case bizzare bugs.


ii) Calling C routines from FORTRAN:

Note that each of the following two statements to export a C routine to FORTRAN
create FORTRAN 'wrappers', written in C, which must be compiled and linked
along with the original C routines and with the FORTRAN calling code.

VAX VMS user's will have to redefine the one of the macros fcallsc or ccallsc.
See the examples or existing applications for details and information.

FCALLSCSUBn(routine_name, argtype_1, ..., argtype_n)

or

FCALLSCFUNn(routine_type, routine_name, argtype_1, ..., argtype_n)

Where:
'n' = 0->7 (easily expanded to >7) stands for the number of arguments to the 
    routine.
routine_name = the FORTRAN name of the routine (IN lowercase LETTERS).
routine_type = the type of argument returned by C functions.
             = DOUBLE, FLOAT, INT, LOGICAL, LONG, STRING.
argtype_i    = the type of argument passed to the FORTRAN routine and must be
               consistent in the definition and prototyping of the routine
             = DOUBLE, FLOAT, INT, LOGICAL, LONG, STRING, STRINGV.
               For arrays or for routines changing the values of any of their
                arguments; the C routines expect pointers to these arguments, 
                so the keywords are prepended by a 'P'.
             = PDOUBLE, PFLOAT, PINT, PLOGICAL, PLONG, PSTRING, PSTRINGV, 
               PVOID.
               The keyword PVOID is a generic form of the nonSTRING types.
               STRINGV refers to vector of strings.  


(P)STRING arguments have any trailing blanks removed before being passed to C,
the same holds true for each element in (P)STRINGV. Space is malloc'd in all
cases big enough to hold the original string (elements) as well as C's
terminatinng '\0'. i.e. The useful size of the string (elements) is the same in
both languages. PSTRING(V) => the string (elements) will be copied from the
malloc'd space back into the FORTRAN bytes.

THE FOLLOWING APPLIES TO THE UNIX COMPILERS ONLY:
                             ----
(P)STRINGV for UNIX only: CFORTRAN cannot convert the FORTRAN vector of STRINGS
to the required C vector of STRINGS without explicitly knowing the number of
elements in the vector. The application must do one of the following for each
(P)STRINGV argument in a routine before that routine's FCALLSCFUNn/SUBn is
called:

#define routine_name_STRV_Ai NUM_ELEMS(j)
 or
#define routine_name_STRV_Ai NUM_ELEM_ARG(k)
 or
#define routine_name_STRV_Ai TERM_CHARS(l,m)

where: routine_name     is as above.
       i [i=1->n.]      specifies the argument number of a STRING VECTOR.
       j                would specify a fixed number of elements. 
       k [k=1->n. k!=i] would specify an integer argument which specifies the
                        number of elements.
       l [char]         the terminating character at the beginning of an
                        element, indicating to cfortran that the preceeding
                        elements in the vector are the valid ones.
       m [m=1-...]      the number of terminating characters required to appear
                        at the beginning of the terminating string element.
                        Note that the terminating element is NOT possed on to
                        the C routine.

e.g. 
CFORTRAN will pass on all elements, in the 1st and only argument to the C
routine ce, of the STRING VECTOR until, but not including, the first string
element beginning with 2 blank, ' ', characters.

#define ce_STRV_A1 TERM_CHARS(' ',2)
FCALLSCSUB1(ce,STRINGV)

Again the lists of types are not neccessarily complete. CFORTRAN may be
expanded to handle a new type not among the above. 



              ===> USER'S OF CFORTRAN NEED READ NO FURTHER <===


III Some Details of and Comments on CFORTRAN
--------------------------------------------

The following notes should be useful to those wishing to port CFORTRAN to new
types of machines.


CFORTRAN.H consist of about 1000 lines of source code. Only about 200 lines of
CFORTRAN.H are interesting, the rest are slightly modified 'repeats'. Porting
CFORTRAN applications, e.g. the hbook.h and cstring.c mentioned above, to
other machines is trivial.  hbook.h is machine independant, and cstring.c will
at most need to have the 'fcallsc' macro redefined. Porting CFORTRAN itself
requires a solid knowledge of the new machines C preprocessor, and its FORTRAN
argument passing mechanisms. Logically CFORTRAN exists as two halves, a "C
CALLS FORTRAN" and a "FORTRAN CALLS C" utility. In some cases it may be
perfectly reasonable to port only 'one half' of CFORTRAN onto a new system.


CFORTRAN is simple enough to be used by the most basic of applications, i.e.
making a single C/FORTRAN routine available to the FORTRAN/C programmers. Yet
CFORTRAN is powerful enough to easily make entire C/FORTRAN libraries available
to FORTRAN/C programmers. 


CFORTRAN is the ideal tool for FORTRAN libraries which are being rewritten in
C. It allows the routines to be written in 'natural C', without having to 
consider the FORTRAN argument passing mechanisms of any machine. It also allows
C code accessing these rewritten routines, to use the C entry point. Without
CFORTRAN one could fall into the perverse practice of C code calling a C
function using FORTRAN argument passing mechanisms!


Perhap the philosophy and mechanisms of CFORTRAN could be used and extended 
to create other language bridges such as ADAFORTRAN, CPASCAL, COCCAM, etc.



IV Pros, Cons and Improvements to CFORTRAN
------------------------------------------

The C calls FORTRAN half is all pro. A list would include:

i) Machine independant and C or FORTRAN independant calls to FORTRAN code.
e.g. C      :       hbook1(1,"pT spectrum of pi+",100,0.,5.,0.);
     FORTRAN:  call hbook1(1,'pT spectrum of pi+',100,0.,5.,0.)
ii) Non-STRING(V) arguments have no, or at most one assignment as overhead.
iii) 'Input only' arguments are protected by using an intermediate value.
iv) I don't think STRING(V)'s can be handled much faster, even in individually
tuned routines. 


The FORTRAN calls C half has the fundamental inelegancy of using an
intermediate function. Perhaps a preprocessor and those %DEF (?) FORTRAN
extensions could help. I don't know, I'm just a C programmer who wants to use
routines written in FORTRAN.


It might make sense to have separate CFORTRAN and FORTRANC utilities, but I've
left them tied together for the moment.


Using FCALLSCFUNn and CCALLSFFUNn for a function in the same source code, i.e.
creating the FORTRAN entry to a C function and then allowing C to call this
FORTRAN entry, obviously serves only test purposes. Note that the order given
above is a must, and that a compiler warning is generated because the FORTRAN
function prototype generated by CCALLSFFUNn does not match the entry point
created by FCALLSCFUNn. This might be fixable, see CFORTRAN.H, but since these
combo.'s are used in tests only, I don't think it's worth it. I say might
because I'm not sure one can satisfy the case sensitive compiler here.



V Machine Dependancies of CFORTRAN
----------------------------------

I leave it to the lucky programmer porting CFORTRAN to a new machine, to 
discover the FORTRAN argument passing mechanisms. A safe starting point is to
assume that variables and arrays are simply passed by reference as they are in
VAX VMS and UNIX, but I make no guarantees. Strings, and n-dimensional arrays
of strings are a different story. I doubt that any systems do it quite like VAX
VMS does it, so that the UNIX version may provide an easier starting point.


CFORTRAN uses and abuses the ## operator. Although the ## operator proper does
not exist in  VAX VMS nor in MIPS C, a kludge does; /**/ with no space allowed
between the slashes, '/', and the macros or tags one wishes to concatenate.
Note that this  kludge can be used in macro definitions, but the VAX VMS
compiler will barf if  it is used in source code proper. e.g.
#define concat(a,b) a/**/b   /* works*/
{
  concat(pri,ntf)("hello");           /* e.g. */
}
N.B. I have learnt of an alternate kludge to /**/ which could replace ##. 
On some compilers without ##, /**/ may also not work, this new kludge may be a
way out. For more info., porters of CFORTRAN should contact me.



VI Machine Dependancies of CFORTRAN Applications
------------------------------------------------

The only machine dependancy of CFORTRAN Applications I know of are the names of
routines written in C to be called by FORTRAN. This problem arises under VAX
VMS because the 'interpreter' routine, written in C and called by the FORTRAN
code, needs an object code name for itself different from that of the original
C routine it will try to invoke.

This problem does not exist with some FORTRAN compilers. E.g. MIPS' f77
appends  each FORTRAN module name with a single underscore, '_', character.
Hence, if all C interpreter routines are prepended with this '_', all is well.
A similar solution may exist when a case sensitive linker is available.

For other compilers, which leave the FORTRAN name as the module name, there 
exist only two situations.
i)  If the C source code for the routines is NOT available, the calls to 
    the C routine from FORTRAN must use a different name. In fortran.h the
    'fcallsc' [f-calls-c] macro exists to modify the names of the interpreter
    routines in a consistent manner.
ii) If the C source code does exist, a decision for one of the two following
    possible resolutions has to be made. 
    a) The source code is left alone and an identical approach to i) above is
       taken. This might be preferable for smaller applications, where the
       C expertise doesn't exist or has better things to do.
    b) This is the better method in that it maintains absolute transparency
       at the user level, unfortunately it is more complicated, but with care
       it is just as robust at the user level. In short, the objects compiled 
       from the original C modules are renamed. This is done in the header 
       file prototyping the original C routines code. Unfortunately this 
       translation also has to be done when C code calls the C routine. Since 
       the name modification is done in the routines header file, it's hidden 
       from the C user, unless they carefully examines the libraries and/or 
       object code. In CFORTRAN.H the 'ccallsc' [c-calls-c] macro exists to 
       modify the names of the original routines in a consistent manner.




THIS SOFTWARE IS PUBLIC DOMAIN. IT MAY BE FREELY COPIED AND USED EVERYWHERE. IT
MAY BE DISTRIBUTED WITH NON-COMMERCIAL PRODUCTS, ASSUMING PROPER CREDIT TO THE
AUTHOR IS GIVEN, BUT IT SHOULD NOT BE RESOLD. IF YOU WANT TO DISTRIBUTE THE
SOFTWARE WITH A COMMERCIAL PRODUCT, CONTACT THE AUTHOR. 
THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
EXPRESSED OR IMPLIED. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST
OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.

VAX VMS, Silicon Graphics (SGI), DECstations, Mips RISC and IBM RS/6000 
are registered trademarks.

/* end: cfortran.doc */
--------------cut for cfortran_unix.h----------------------------------
/* cfortran.h */
/* Burkhard Burow, burow%13313.hepnet@csa3.lbl.gov, U. of Toronto, 1991. */

#if !defined(mips) && !defined(rs6000)
??=error This header file is for the following compilers:
??=error - MIPS C and FORTRAN 2.0. (e.g. Silicon Graphics, DECstations, ...)
??=error - IBM AIX XL C and FORTRAN Compiler/6000 Version 01.01.0000.0000
??=error       cc -Drs6000 is req.d on the RS/6000. 
??=error       [Do predefined macros exist for the rs6000 id?]
#else

#ifndef __CFORTRAN_LOADED
#define __CFORTRAN_LOADED	1

#include <string.h>
#include <stdio.h>
#include <stdlib.h>

#ifdef mips
#define C_(A) A/**/_
#define ccallsc(NAME)          NAME
#else 
#define C_(A) A
#define ccallsc(NAME)          CF/**/NAME
#endif

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

/*               UTILITIES USED WITHIN CFORTRAN                            */

#define MIN(A,B) ((A)<(B)?(A):(B))
#define firstindexlength( A) (sizeof(A)     /sizeof(A[0]))
#define secondindexlength(A) (sizeof((A)[0])/sizeof((A)[0][0]))
#define COMMON_BLOCK(C) C_(C)
#define C_FUNCTION(NAME)       C_(NAME)
#define FORTRAN_FUNCTION(NAME) C_(NAME)
typedef struct {unsigned short clen, flen;} CFSTRLEN;

/* kill the trailing char t's in string s. */
#define kill_trailing(s,t) kill_trailingn((s),(t),(s)+strlen(s))

/* kill_trailingn(s,t,e) will kill the trailing t's in string s. e normally 
points to the terminating '\0' of s, but may actually point to anywhere in s.
s's new '\0' will be placed at e or earlier in order to remove any trailing t's.
If e<s string s is left unchanged. */ 
static char *kill_trailingn(char *s, char t, char *e)
{ 
if (e==s) *e = '\0';                 /* Kill the string makes sense here.*/
else if (e>s) {                      /* Watch out for neg. length string.*/
  while (e>s && *--e==t);            /* Don't follow t's past beginning. */
  e[*e==t?0:1] = '\0';               /* Handle s[0]=t correctly.       */
}
return s;
}

/* Note the following assumes that any element which has t's to be chopped off,
does indeed fill the entire element. */
static char *vkill_trailing(char* cstr, int elem_len, int sizeofcstr, char t)
{ int i;
for (i=0; i<sizeofcstr/elem_len; i++) /* elem_len includes \0 for C strings. */
  kill_trailingn(cstr+elem_len*i,t,cstr+elem_len*(i+1)-1);
return cstr;
}

/* Convert a vector of C strings into FORTRAN strings. */
static char *c2fstrv(char* cstr, char *fstr, int elem_len, int sizeofcstr)
{ int i,j;
/* elem_len includes \0 for C strings. Fortran strings don't have term. \0.
   Useful size of string must be the same in both languages. */
for (i=0; i<sizeofcstr/elem_len; i++) {
  for (j=1; j<elem_len && *cstr; j++) *fstr++ = *cstr++;
  cstr += 1+elem_len-j;
  for (; j<elem_len; j++) *fstr++ = ' ';
}
return fstr-sizeofcstr+sizeofcstr/elem_len;
}

/* Convert a vector of FORTRAN strings into C strings. */
static char *f2cstrv(char *fstr, char* cstr, int elem_len, int sizeofcstr)
{ int i,j;
/* elem_len includes \0 for C strings. Fortran strings don't have term. \0.
   Useful size of string must be the same in both languages. */
cstr += sizeofcstr;
fstr += sizeofcstr - sizeofcstr/elem_len;
for (i=0; i<sizeofcstr/elem_len; i++) {
  *--cstr = '\0';
  for (j=1; j<elem_len; j++) *--cstr = *--fstr;
}
return cstr;
}

#define _NUM_ELEMS      -1
#define _NUM_ELEM_ARG   -2
#define NUM_ELEMS(A)    A,_NUM_ELEMS
#define NUM_ELEM_ARG(B) *A/**/B,_NUM_ELEM_ARG
#define TERM_CHARS(A,B) A,B
static int num_elem(char *strv, unsigned elem_len, int term_char,
                    int num_term_char)
/* elem_len is the number of characters in each element of strv, the FORTRAN
vector of strings. The last element of the vector must begin with at least
num_term_char term_char characters, so that this routine can determine how 
many elements are in the vector. */
{
unsigned num,i;
if (num_term_char == _NUM_ELEMS || num_term_char == _NUM_ELEM_ARG) 
  return term_char;
if (num_term_char <=0) num_term_char = elem_len;
for (num=0; ; num++) {
  for (i=0; i<num_term_char && *strv==term_char; i++,strv++);
  if (i==num_term_char) break;
  else strv += elem_len-i;
}
return num;
}

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

/*               UTILITIES FOR C TO CALL FORTRAN SUBROUTINES               */

/* Define lookup tables for how to handle the various types of variables. */
#define VCF(TN,I)      V/**/TN(A/**/I,B/**/I)
#define VDOUBLE(  A,B) double  B = A;
#define VFLOAT(   A,B) float   B = A;
#define VINT(     A,B) int     B = (int)A;      /* typecast for enum's sake */
#define VLOGICAL( A,B) int     B = A;
#define VLONG(    A,B) long    B = A;
#define VSTRING(  A,B) CFSTRLEN B;
#define VDOUBLEV( A,B) double *B = A;
#define VFLOATV(  A,B) float  *B = A;
#define VINTV(    A,B) int    *B = A;
#define VSTRINGV( A,B) struct {char *s; unsigned flen;} B;
#define VDOUBLEVV(A,B) double *B = A[0];
#define VFLOATVV( A,B) float  *B = A[0];
#define VINTVV(   A,B) int    *B = A[0];
#define VPDOUBLE( A,B)
#define VPFLOAT(  A,B)
#define VPINT(    A,B)
#define VPLOGICAL(A,B)
#define VPLONG(   A,B)
#define VPSTRING( A,B) int     B;
#define VPSTRINGV(A,B) struct {unsigned short sizeofA, flen;} B;
#define VPVOID(   A,B)
#define VPSTRUCT( A,B)

#define ADOUBLE(  A,B) &B
#define AFLOAT(   A,B) &B
#define AINT(     A,B) &B
#define ALOGICAL( A,B) &B
#define ALONG(    A,B) &B
#define ASTRING(  A,B) CSTRING(A,B,sizeof(A))
#define ADOUBLEV( A,B)  B
#define AFLOATV(  A,B)  B
#define AINTV(    A,B)  B
#define ASTRINGV( A,B) (B.s=malloc(sizeof(A)-firstindexlength(A)),             \
                  c2fstrv(A[0],B.s,(B.flen=secondindexlength(A)-1)+1,sizeof(A)))
#define ADOUBLEVV(A,B)  B
#define AFLOATVV( A,B)  B
#define AINTVV(   A,B)  B
#define APDOUBLE( A,B) &A
#define APFLOAT(A,B)   &A
#define APINT(    A,B) (int *) & A   /* typecast for enum's sake */
#define APLOGICAL(A,B) &A
#define APLONG(   A,B) &A
#define APSTRING( A,B) CPSTRING(A,B,sizeof(A))
#define APSTRINGV(A,B) c2fstrv(A[0],A[0],(B.flen=secondindexlength(A)-1)+1,    \
                               B.sizeofA=sizeof(A))
#define APVOID(   A,B) (void *) A
#define APSTRUCT( A,B) (void *)&A

#define JCF(TN,I)      J/**/TN(A/**/I,B/**/I)
#define JDOUBLE(  A,B)
#define JFLOAT(   A,B)
#define JINT(     A,B)
#define JLOGICAL( A,B)
#define JLONG(    A,B)
#define JSTRING(  A,B) ,B.flen
#define JDOUBLEV( A,B)
#define JFLOATV(  A,B)
#define JINTV(    A,B)
#define JSTRINGV( A,B) ,B.flen
#define JDOUBLEVV(A,B)
#define JFLOATVV( A,B)
#define JINTVV(   A,B)
#define JPDOUBLE( A,B)
#define JPFLOAT(  A,B)
#define JPINT(    A,B)
#define JPLOGICAL(A,B)
#define JPLONG(   A,B)
#define JPSTRING( A,B) ,B
#define JPSTRINGV(A,B) ,B.flen
#define JPVOID(   A,B)
#define JPSTRUCT( A,B)

#define WCF(TN,I)      W/**/TN(A/**/I,B/**/I)
#define WDOUBLE(  A,B)
#define WFLOAT(   A,B)
#define WINT(     A,B)
#define WLOGICAL( A,B)
#define WLONG(    A,B)
#define WSTRING(  A,B) (A[B.clen]!='\0'?A[B.clen]='\0':0);
#define WDOUBLEV( A,B)
#define WFLOATV(  A,B)
#define WINTV(    A,B)
#define WSTRINGV( A,B) free(B.s);
#define WDOUBLEVV(A,B)
#define WFLOATVV( A,B)
#define WINTVV(   A,B)
#define WPDOUBLE( A,B)
#define WPFLOAT(  A,B)
#define WPINT(    A,B)
#define WPLOGICAL(A,B)
#define WPLONG(   A,B)
#define WPSTRING( A,B) kill_trailing(A,' ');
#define WPSTRINGV(A,B) vkill_trailing(                                         \
         f2cstrv((char*)A,(char*)A,B.flen+1,B.sizeofA), B.flen+1,B.sizeofA,' ');
#define WPVOID(   A,B)                                
#define WPSTRUCT( A,B)

#define NDOUBLE        double *
#define NFLOAT         float  *
#define NINT           int    *
#define NLOGICAL       int    *
#define NLONG          long   *
#define NSTRING        char   *
#define NDOUBLEV       double *
#define NFLOATV        float  *
#define NINTV          int    *
#define NSTRINGV       char   *
#define NDOUBLEVV      double *
#define NFLOATVV       float  *
#define NINTVV         int    *
#define NPDOUBLE       double *
#define NPFLOAT        float  *
#define NPINT          int    *
#define NPLOGICAL      int    *
#define NPLONG         long   *
#define NPSTRING       char   *
#define NPSTRINGV      char   *
#define NPVOID         void   *
#define NPSTRUCT       void   *
         
/* WARNING: CCALLSFSUBn and PROTOCCALLSFFUNn use the fact that the arguments to
routines are evaluated left to right. i.e. The J... entries are dependant on
results from the A and the C tables. This works here, but is a hazard when
moving to a different compiler. */

#define CCALLSFSUB0(NAME) {C_(NAME)();}

#define CCALLSFSUB1(NAME,T1,A1)                                                \
{V/**/T1(A1,B1) C_(NAME)(A/**/T1(A1,B1) J/**/T1(A1,B1)); W/**/T1(A1,B1)}

#define CCALLSFSUB2(NAME,T1,T2,A1,A2)                                          \
{V/**/T1(A1,B1) V/**/T2(A2,B2)                                                 \
 C_(NAME)(A/**/T1(A1,B1),A/**/T2(A2,B2) J/**/T1(A1,B1) J/**/T2(A2,B2));        \
 W/**/T1(A1,B1) W/**/T2(A2,B2)}

#define CCALLSFSUB3(NAME,T1,T2,T3,A1,A2,A3)                                    \
{V/**/T1(A1,B1) V/**/T2(A2,B2) V/**/T3(A3,B3)                                  \
 C_(NAME)(A/**/T1(A1,B1),A/**/T2(A2,B2),A/**/T3(A3,B3)                         \
          J/**/T1(A1,B1) J/**/T2(A2,B2) J/**/T3(A3,B3));                       \
 W/**/T1(A1,B1) W/**/T2(A2,B2) W/**/T3(A3,B3)}

#define CCALLSFSUB4(NAME,T1,T2,T3,T4,A1,A2,A3,A4)                              \
{V/**/T1(A1,B1) V/**/T2(A2,B2) V/**/T3(A3,B3) V/**/T4(A4,B4)                   \
 C_(NAME)(A/**/T1(A1,B1),A/**/T2(A2,B2),A/**/T3(A3,B3),A/**/T4(A4,B4)          \
          J/**/T1(A1,B1) J/**/T2(A2,B2) J/**/T3(A3,B3) J/**/T4(A4,B4));        \
 W/**/T1(A1,B1) W/**/T2(A2,B2) W/**/T3(A3,B3) W/**/T4(A4,B4)}

#define CCALLSFSUB5(NAME,T1,T2,T3,T4,T5,A1,A2,A3,A4,A5)                        \
{V/**/T1(A1,B1) V/**/T2(A2,B2) V/**/T3(A3,B3) V/**/T4(A4,B4) V/**/T5(A5,B5)    \
 C_(NAME)(A/**/T1(A1,B1),A/**/T2(A2,B2),A/**/T3(A3,B3),A/**/T4(A4,B4),         \
          A/**/T5(A5,B5) J/**/T1(A1,B1) J/**/T2(A2,B2) J/**/T3(A3,B3)          \
          J/**/T4(A4,B4) J/**/T5(A5,B5));                                      \
 W/**/T1(A1,B1) W/**/T2(A2,B2) W/**/T3(A3,B3) W/**/T4(A4,B4) W/**/T5(A5,B5)}

#define CCALLSFSUB6(NAME,T1,T2,T3,T4,T5,T6,A1,A2,A3,A4,A5,A6)                  \
{V/**/T1(A1,B1) V/**/T2(A2,B2) V/**/T3(A3,B3) V/**/T4(A4,B4)                   \
 V/**/T5(A5,B5) V/**/T6(A6,B6)                                                 \
 C_(NAME)(A/**/T1(A1,B1),A/**/T2(A2,B2),A/**/T3(A3,B3),A/**/T4(A4,B4),         \
          A/**/T5(A5,B5),A/**/T6(A6,B6) J/**/T1(A1,B1) J/**/T2(A2,B2)          \
          J/**/T3(A3,B3) J/**/T4(A4,B4) J/**/T5(A5,B5) J/**/T6(A6,B6));        \
 W/**/T1(A1,B1) W/**/T2(A2,B2) W/**/T3(A3,B3) W/**/T4(A4,B4)                   \
 W/**/T5(A5,B5) W/**/T6(A6,B6)}

#define CCALLSFSUB7(NAME,T1,T2,T3,T4,T5,T6,T7,A1,A2,A3,A4,A5,A6,A7)            \
{V/**/T1(A1,B1) V/**/T2(A2,B2) V/**/T3(A3,B3) V/**/T4(A4,B4)                   \
 V/**/T5(A5,B5) V/**/T6(A6,B6) V/**/T7(A7,B7)                                  \
 C_(NAME)(A/**/T1(A1,B1),A/**/T2(A2,B2),A/**/T3(A3,B3),A/**/T4(A4,B4),         \
          A/**/T5(A5,B5),A/**/T6(A6,B6),A/**/T7(A7,B7)                         \
          J/**/T1(A1,B1) J/**/T2(A2,B2) J/**/T3(A3,B3) J/**/T4(A4,B4)          \
          J/**/T5(A5,B5) J/**/T6(A6,B6) J/**/T7(A7,B7));                       \
 W/**/T1(A1,B1) W/**/T2(A2,B2) W/**/T3(A3,B3) W/**/T4(A4,B4)                   \
 W/**/T5(A5,B5) W/**/T6(A6,B6) W/**/T7(A7,B7)}

#define CCALLSFSUB8(NAME,T1,T2,T3,T4,T5,T6,T7,T8,A1,A2,A3,A4,A5,A6,A7,A8)      \
{V/**/T1(A1,B1) V/**/T2(A2,B2) V/**/T3(A3,B3) V/**/T4(A4,B4)                   \
 V/**/T5(A5,B5) V/**/T6(A6,B6) V/**/T7(A7,B7) V/**/T8(A8,B8)                   \
 C_(NAME)(A/**/T1(A1,B1),A/**/T2(A2,B2),A/**/T3(A3,B3),A/**/T4(A4,B4),         \
          A/**/T5(A5,B5),A/**/T6(A6,B6),A/**/T7(A7,B7),A/**/T8(A8,B8)          \
          J/**/T1(A1,B1) J/**/T2(A2,B2) J/**/T3(A3,B3) J/**/T4(A4,B4)          \
          J/**/T5(A5,B5) J/**/T6(A6,B6) J/**/T7(A7,B7) J/**/T8(A8,B8));        \
 W/**/T1(A1,B1) W/**/T2(A2,B2) W/**/T3(A3,B3) W/**/T4(A4,B4)                   \
 W/**/T5(A5,B5) W/**/T6(A6,B6) W/**/T7(A7,B7) W/**/T8(A8,B8)}

#define CCALLSFSUB9(NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9,A1,A2,A3,A4,A5,A6,A7,A8,A9)\
{V/**/T1(A1,B1) V/**/T2(A2,B2) V/**/T3(A3,B3) V/**/T4(A4,B4)                   \
 V/**/T5(A5,B5) V/**/T6(A6,B6) V/**/T7(A7,B7) V/**/T8(A8,B8) V/**/T9(A9,B9)    \
 C_(NAME)(A/**/T1(A1,B1),A/**/T2(A2,B2),A/**/T3(A3,B3),A/**/T4(A4,B4),         \
          A/**/T5(A5,B5),A/**/T6(A6,B6),A/**/T7(A7,B7),A/**/T8(A8,B8),         \
          A/**/T9(A9,B9) J/**/T1(A1,B1) J/**/T2(A2,B2) J/**/T3(A3,B3)          \
          J/**/T4(A4,B4) J/**/T5(A5,B5) J/**/T6(A6,B6) J/**/T7(A7,B7)          \
          J/**/T8(A8,B8) J/**/T9(A9,B9));                                      \
 W/**/T1(A1,B1) W/**/T2(A2,B2) W/**/T3(A3,B3) W/**/T4(A4,B4)                   \
 W/**/T5(A5,B5) W/**/T6(A6,B6) W/**/T7(A7,B7) W/**/T8(A8,B8) W/**/T9(A9,B9)}

#define CCALLSFSUB10(NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,                       \
                          A1,A2,A3,A4,A5,A6,A7,A8,A9,AA)                       \
{V/**/T1(A1,B1) V/**/T2(A2,B2) V/**/T3(A3,B3) V/**/T4(A4,B4) V/**/T5(A5,B5)    \
 V/**/T6(A6,B6) V/**/T7(A7,B7) V/**/T8(A8,B8) V/**/T9(A9,B9) V/**/TA(AA,BA)    \
 C_(NAME)(A/**/T1(A1,B1),A/**/T2(A2,B2),A/**/T3(A3,B3),A/**/T4(A4,B4),         \
          A/**/T5(A5,B5),A/**/T6(A6,B6),A/**/T7(A7,B7),A/**/T8(A8,B8),         \
          A/**/T9(A9,B9),A/**/TA(AA,BA) J/**/T1(A1,B1) J/**/T2(A2,B2)          \
          J/**/T3(A3,B3) J/**/T4(A4,B4) J/**/T5(A5,B5) J/**/T6(A6,B6)          \
          J/**/T7(A7,B7) J/**/T8(A8,B8) J/**/T9(A9,B9) J/**/TA(AA,BA));        \
 W/**/T1(A1,B1) W/**/T2(A2,B2) W/**/T3(A3,B3) W/**/T4(A4,B4) W/**/T5(A5,B5)    \
 W/**/T6(A6,B6) W/**/T7(A7,B7) W/**/T8(A8,B8) W/**/T9(A9,B9) W/**/TA(AA,BA) }

#define CCALLSFSUB11(NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,                    \
                          A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB)                    \
{V/**/T1(A1,B1) V/**/T2(A2,B2) V/**/T3(A3,B3) V/**/T4(A4,B4) V/**/T5(A5,B5)    \
 V/**/T6(A6,B6) V/**/T7(A7,B7) V/**/T8(A8,B8) V/**/T9(A9,B9) V/**/TA(AA,BA)    \
 V/**/TB(AB,BB)                                                                \
 C_(NAME)(A/**/T1(A1,B1),A/**/T2(A2,B2),A/**/T3(A3,B3),A/**/T4(A4,B4),         \
          A/**/T5(A5,B5),A/**/T6(A6,B6),A/**/T7(A7,B7),A/**/T8(A8,B8),         \
          A/**/T9(A9,B9),A/**/TA(AA,BA),A/**/TB(AB,BB) J/**/T1(A1,B1)          \
          J/**/T2(A2,B2) J/**/T3(A3,B3) J/**/T4(A4,B4) J/**/T5(A5,B5)          \
          J/**/T6(A6,B6) J/**/T7(A7,B7) J/**/T8(A8,B8) J/**/T9(A9,B9)          \
          J/**/TA(AA,BA) J/**/TB(AB,BB));                                      \
 W/**/T1(A1,B1) W/**/T2(A2,B2) W/**/T3(A3,B3) W/**/T4(A4,B4) W/**/T5(A5,B5)    \
 W/**/T6(A6,B6) W/**/T7(A7,B7) W/**/T8(A8,B8) W/**/T9(A9,B9) W/**/TA(AA,BA)    \
 W/**/TB(AB,BB) }

#define CCALLSFSUB16(NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,     \
                          A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG)     \
{V/**/T1(A1,B1) V/**/T2(A2,B2) V/**/T3(A3,B3) V/**/T4(A4,B4) V/**/T5(A5,B5)    \
 V/**/T6(A6,B6) V/**/T7(A7,B7) V/**/T8(A8,B8) V/**/T9(A9,B9) V/**/TA(AA,BA)    \
 V/**/TB(AB,BB) V/**/TC(AC,BC) V/**/TD(AD,BD) V/**/TE(AE,BE) V/**/TF(AF,BF)    \
 V/**/TG(AG,BG)                                                                \
 C_(NAME)(A/**/T1(A1,B1),A/**/T2(A2,B2),A/**/T3(A3,B3),A/**/T4(A4,B4),         \
          A/**/T5(A5,B5),A/**/T6(A6,B6),A/**/T7(A7,B7),A/**/T8(A8,B8),         \
          A/**/T9(A9,B9),A/**/TA(AA,BA),A/**/TB(AB,BB),A/**/TC(AC,BC),         \
          A/**/TD(AD,BD),A/**/TE(AE,BE),A/**/TF(AF,BF),A/**/TG(AG,BG)          \
          J/**/T1(A1,B1) J/**/T2(A2,B2) J/**/T3(A3,B3) J/**/T4(A4,B4)          \
          J/**/T5(A5,B5) J/**/T6(A6,B6) J/**/T7(A7,B7) J/**/T8(A8,B8)          \
          J/**/T9(A9,B9) J/**/TA(AA,BA) J/**/TB(AB,BB) J/**/TC(AC,BC)          \
          J/**/TD(AD,BD) J/**/TE(AE,BE) J/**/TF(AF,BF) J/**/TG(AG,BG));        \
 W/**/T1(A1,B1) W/**/T2(A2,B2) W/**/T3(A3,B3) W/**/T4(A4,B4) W/**/T5(A5,B5)    \
 W/**/T6(A6,B6) W/**/T7(A7,B7) W/**/T8(A8,B8) W/**/T9(A9,B9) W/**/TA(AA,BA)    \
 W/**/TB(AB,BB) W/**/TC(AC,BC) W/**/TD(AD,BD) W/**/TE(AE,BE) W/**/TF(AF,BF)    \
 W/**/TG(AG,BG) }

#define PROTOCCALLSFSUB0(NAME) void C_(NAME)();
#define PROTOCCALLSFSUB1(NAME,T1) void C_(NAME)(N/**/T1, ...);
#define PROTOCCALLSFSUB2(NAME,T1,T2) void C_(NAME)(N/**/T1,N/**/T2, ...);
#define PROTOCCALLSFSUB3(NAME,T1,T2,T3) void C_(NAME)(N/**/T1,N/**/T2,N/**/T3, \
                                                      ...);
#define PROTOCCALLSFSUB4(NAME,T1,T2,T3,T4)                                     \
                    void C_(NAME)(N/**/T1,N/**/T2,N/**/T3,N/**/T4, ...);
#define PROTOCCALLSFSUB5(NAME,T1,T2,T3,T4,T5)                                  \
                    void C_(NAME)(N/**/T1,N/**/T2,N/**/T3,N/**/T4,N/**/T5, ...);
#define PROTOCCALLSFSUB6(NAME,T1,T2,T3,T4,T5,T6)                               \
                    void C_(NAME)(N/**/T1,N/**/T2,N/**/T3,N/**/T4,N/**/T5,     \
                                  N/**/T6, ...);
#define PROTOCCALLSFSUB7(NAME,T1,T2,T3,T4,T5,T6,T7)                            \
                    void C_(NAME)(N/**/T1,N/**/T2,N/**/T3,N/**/T4,N/**/T5,     \
                                  N/**/T6,N/**/T7, ...);
#define PROTOCCALLSFSUB8(NAME,T1,T2,T3,T4,T5,T6,T7,T8)                         \
                    void C_(NAME)(N/**/T1,N/**/T2,N/**/T3,N/**/T4,N/**/T5,     \
                                  N/**/T6,N/**/T7,N/**/T8, ...);
#define PROTOCCALLSFSUB9(NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9)                      \
                    void C_(NAME)(N/**/T1,N/**/T2,N/**/T3,N/**/T4,N/**/T5,     \
                                  N/**/T6,N/**/T7,N/**/T8,N/**/T9, ...);
#define PROTOCCALLSFSUB10(NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA)                  \
                    void C_(NAME)(N/**/T1,N/**/T2,N/**/T3,N/**/T4,N/**/T5,     \
                                  N/**/T6,N/**/T7,N/**/T8,N/**/T9,N/**/TA, ...);
#define PROTOCCALLSFSUB11(NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB)               \
                    void C_(NAME)(N/**/T1,N/**/T2,N/**/T3,N/**/T4,N/**/T5,     \
                                  N/**/T6,N/**/T7,N/**/T8,N/**/T9,N/**/TA,     \
                                  N/**/TB, ...);
#define PROTOCCALLSFSUB16(NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG)\
                    void C_(NAME)(N/**/T1,N/**/T2,N/**/T3,N/**/T4,N/**/T5,     \
                                  N/**/T6,N/**/T7,N/**/T8,N/**/T9,N/**/TA,     \
                                  N/**/TB,N/**/TC,N/**/TD,N/**/TE,N/**/TF,     \
                                  N/**/TG, ...);

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

/*               UTILITIES FOR C TO CALL FORTRAN FUNCTIONS                 */

/*N.B. PROTOCCALLSFFUNn(..) generates code, whether or not the FORTRAN
  function is called. Therefore, especially for creator's of C header files
  for large FORTRAN libraries which include many functions, to reduce
  compile time and object code size, it may be desirable to create
  preprocessor directives to allow users to create code for only those
  functions which they use.                                                */

/* The following defines the maximum length string that a function can return.
   Of course it may be undefine-d and re-define-d before individual
   PROTOCCALLSFFUNn(..) as required.                                       */
#define MAX_LEN_FORTRAN_FUNCTION_STRING 0x4FE

/* The following defines a character used by CFORTRAN to flag the end of a
   string coming out of a FORTRAN routine.                                 */
#define CFORTRAN_NON_CHAR 0x7F

#define UDOUBLE        double
#define UFLOAT         float
#define UINT           int
#define ULOGICAL       int
#define ULONG          long
#define USTRING        char   *
#define UFLOATV        float  *
#define UINTV          int    *
#define USTRINGV       char   *
#define UFLOATVV       float  *
#define UINTVV         int    *
#define UPDOUBLE       double *
#define UPFLOAT        float  *
#define UPINT          int    *
#define UPLOGICAL      int    *
#define UPLONG         long   *
#define UPSTRING       char   *
#define UPSTRINGV      char   *
#define UPVOID         void   *
#define UVOID          void   * /*Needed for FORTRAN calls to C subroutines. */
#define UPSTRUCT       void   *

#define EDOUBLE        double A0;
#define EFLOAT         float  A0;
#define EINT           int    A0;
#define ELOGICAL       int    A0;
#define ELONG          long   A0;
#define ESTRING        static char A0[MAX_LEN_FORTRAN_FUNCTION_STRING+1];      \
                       memset(A0, CFORTRAN_NON_CHAR,                           \
                              MAX_LEN_FORTRAN_FUNCTION_STRING);                \
                       *(A0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0';
/* ESTRING uses static char. array which exists after function returns.  */

/* N.B.i) The diff. for 0 (Zero) and >=1 arguments.
       ii)That the folowing create a single unmatched '(' bracket.
       iii)Commas must be handled very carefully                         */
#define GZDOUBLE(   B) A0=C_(B)(
#define GZFLOAT(    B) A0=C_(B)(
#define GZINT(      B) A0=C_(B)(
#define GZLOGICAL(  B) A0=C_(B)(
#define GZLONG(     B) A0=C_(B)(
#define GZSTRING(   B) C_(B)(A0,MAX_LEN_FORTRAN_FUNCTION_STRING

#define GDOUBLE(    B) A0=C_(B)(
#define GFLOAT(     B) A0=C_(B)(
#define GINT(       B) A0=C_(B)(
#define GLOGICAL(   B) A0=C_(B)(
#define GLONG(      B) A0=C_(B)(
#define GSTRING(    B) GZSTRING(B),

#define BDOUBLE(    A) (double)   A
#define BFLOAT(     A) (float)    A
#define BINT(       A) (int)      A    /* typecast for enum's sake */
#define BLOGICAL(   A) (int)      A
#define BLONG(      A) (long)     A
#define BSTRING(    A) (char *)   A
#define BFLOATV(    A)            A
#define BINTV(      A)            A
#define BSTRINGV(   A)            A[0]
#define BFLOATVV(   A)           (A)[0]
#define BINTVV(     A)           (A)[0]
#define BPDOUBLE(   A) (double *)&A
#define BPFLOAT(    A) (float  *)&A
#define BPINT(      A) (int    *)&A /* typecast for enum's sake */
#define BPLOGICAL(  A) (int    *)&A
#define BPLONG(     A) (long   *)&A
#define BPSTRING(   A) (char   *) A
#define BPSTRINGV(  A)            A[0]
#define BPVOID(     A) (void   *) A
#define BPSTRUCT(   A) (void   *)&A

#define SDOUBLE(    A)
#define SFLOAT(     A)
#define SINT(       A)
#define SLOGICAL(   A)
#define SLONG(      A)
#define SSTRING(    A) ,sizeof(A)
#define SFLOATV(    A)
#define SINTV(      A)
#define SSTRINGV(   A) ,( (unsigned)0xFFFF*firstindexlength(A)                 \
                         +secondindexlength(A))
#define SFLOATVV(   A)
#define SINTVV(     A)
#define SPDOUBLE(   A)
#define SPFLOAT(    A)
#define SPINT(      A)
#define SPLOGICAL(  A)
#define SPLONG(     A)
#define SPSTRING(   A) ,sizeof(A)
#define SPSTRINGV      SSTRINGV
#define SPVOID(     A)
#define SPSTRUCT(   A)

#define HDOUBLE(    A)
#define HFLOAT(     A)
#define HINT(       A)
#define HLOGICAL(   A)
#define HLONG(      A)
#define HSTRING(    A) ,unsigned A
#define HFLOATV(    A)
#define HINTV(      A)
#define HSTRINGV(   A) ,unsigned A
#define HFLOATVV(   A)
#define HINTVV(     A)
#define HPDOUBLE(   A)
#define HPFLOAT(    A)
#define HPINT(      A)
#define HPLOGICAL(  A)
#define HPLONG(     A)
#define HPSTRING(   A) ,unsigned A
#define HPSTRINGV(  A) ,unsigned A
#define HPVOID(     A)
#define HPSTRUCT(   A)

#define CCF(TN,I)        C/**/TN(A/**/I,B/**/I,C/**/I)
#define CDOUBLE(  A,B,C) &A
#define CFLOAT(   A,B,C) &A
#define CINT(     A,B,C) &A
#define CLOGICAL( A,B,C) &A
#define CLONG(    A,B,C) &A
#define CSTRING(  A,B,C) (B.clen=strlen(A),                                    \
                          C==sizeof(char*)||C==B.clen+1?B.flen=B.clen,(A):     \
                     (memset((A)+B.clen,' ',C-B.clen-1),A[B.flen=C-1]='\0',(A)))
#define CFLOATV(  A,B,C)  A
#define CINTV(    A,B,C)  A
#define CSTRINGV( A,B,C) (B.s=malloc((C/0xFFFF)*(C%0xFFFF-1)),                 \
                     c2fstrv(A,B.s,(B.flen=C%0xFFFF-1)+1,(C/0xFFFF)*(C%0xFFFF)))
#define CFLOATVV( A,B,C)  A
#define CINTVV(   A,B,C)  A
#define CPDOUBLE( A,B,C)  A
#define CPFLOAT(  A,B,C)  A
#define CPINT(    A,B,C)  A         /* typecast for enum's sake */
#define CPLOGICAL(A,B,C)  A
#define CPLONG(   A,B,C)  A
#define CPSTRING( A,B,C) (B=strlen(A), C==sizeof(char*)?(A):                   \
                          (memset((A)+B,' ',C-B-1),A[B=C-1]='\0',(A)))
#define CPSTRINGV(A,B,C) c2fstrv(A,A,(B.flen=C%0xFFFF-1)+1,                    \
                                 B.sizeofA=(C/0xFFFF)*(C%0xFFFF))
#define CPVOID(   A,B,C)  A
#define CPSTRUCT( A,B,C)  A

#define XDOUBLE        return A0;
#define XFLOAT         return A0;
#define XINT           return A0;
#define XLOGICAL       return A0;
#define XLONG          return A0;
#define XSTRING        return kill_trailing(                                \
                              kill_trailing(A0,CFORTRAN_NON_CHAR),' ');

#define CFFUN(NAME) __cf__/**/NAME

#define CCALLSFFUN0(NAME) CFFUN(NAME)()

#define CCALLSFFUN1(NAME,T1,A1) CFFUN(NAME)(B/**/T1(A1) S/**/T1(A1))

#define CCALLSFFUN2(NAME,T1,T2,A1,A2) CFFUN(NAME)(B/**/T1(A1),B/**/T2(A2)      \
                                                  S/**/T1(A1) S/**/T2(A2))

#define CCALLSFFUN3(NAME,T1,T2,T3,A1,A2,A3)                                    \
CFFUN(NAME)(B/**/T1(A1),B/**/T2(A2),B/**/T3(A3)                                \
            S/**/T1(A1) S/**/T2(A2) S/**/T3(A3))

#define CCALLSFFUN4(NAME,T1,T2,T3,T4,A1,A2,A3,A4)                              \
CFFUN(NAME)(B/**/T1(A1),B/**/T2(A2),B/**/T3(A3),B/**/T4(A4)                    \
            S/**/T1(A1) S/**/T2(A2) S/**/T3(A3) S/**/T4(A4))

#define CCALLSFFUN5(NAME,T1,T2,T3,T4,T5,A1,A2,A3,A4,A5)                        \
CFFUN(NAME)(B/**/T1(A1),B/**/T2(A2),B/**/T3(A3),B/**/T4(A4),B/**/T5(A5)        \
            S/**/T1(A1) S/**/T2(A2) S/**/T3(A3) S/**/T4(A4) S/**/T5(A5))

#define CCALLSFFUN6(NAME,T1,T2,T3,T4,T5,T6,A1,A2,A3,A4,A5,A6)                  \
CFFUN(NAME)(B/**/T1(A1),B/**/T2(A2),B/**/T3(A3),B/**/T4(A4),B/**/T5(A5)        \
            B/**/T6(A6)                                                        \
S/**/T1(A1) S/**/T2(A2) S/**/T3(A3) S/**/T4(A4) S/**/T5(A5) S/**/T6(A6))

#define CCALLSFFUN7(NAME,T1,T2,T3,T4,T5,T6,T7,A1,A2,A3,A4,A5,A6,A7)            \
CFFUN(NAME)(B/**/T1(A1),B/**/T2(A2),B/**/T3(A3),B/**/T4(A4),B/**/T5(A5)        \
            B/**/T6(A6),B/**/T7(A7) S/**/T1(A1) S/**/T2(A2) S/**/T3(A3)        \
            S/**/T4(A4) S/**/T5(A5) S/**/T6(A6) S/**/T7(A7))

/* N.B. Create a separate function instead of using (call function, function
value here) because in order to create the variables needed for the input
arg.'s which may be const.'s one has to do the creation within {}, but these
can never be placed within ()'s. Therefore one must create 'wrapper' functions.
*/

#define PROTOCCALLSFFUN0(F,NAME)                                               \
U/**/F NAME(); /* This is needed to correctly handle the value returned */     \
static U/**/F CFFUN(NAME)() {E/**/F  GZ/**/F(NAME)); X/**/F}

#define PROTOCCALLSFFUN1(F,NAME,T1)                                            \
U/**/F C_(NAME)();                                                             \
static U/**/F CFFUN(NAME)(U/**/T1 A1 H/**/T1(C1))                              \
{VCF(T1,1) E/**/F G/**/F(NAME)CCF(T1,1) JCF(T1,1)); WCF(T1,1) X/**/F}

#define PROTOCCALLSFFUN2(F,NAME,T1,T2)                                         \
U/**/F C_(NAME)();                                                             \
static U/**/F CFFUN(NAME)(U/**/T1 A1,U/**/T2 A2 H/**/T1(C1) H/**/T2(C2))       \
{VCF(T1,1) VCF(T2,2) E/**/F G/**/F(NAME)CCF(T1,1),CCF(T2,2)                    \
 JCF(T1,1) JCF(T2,2)); WCF(T1,1) WCF(T2,2) X/**/F}

#define PROTOCCALLSFFUN3(F,NAME,T1,T2,T3)                                      \
U/**/F C_(NAME)();                                                             \
static U/**/F CFFUN(NAME)(U/**/T1 A1,U/**/T2 A2,U/**/T3 A3                     \
                          H/**/T1(C1) H/**/T2(C2) H/**/T3(C3))                 \
{VCF(T1,1) VCF(T2,2) VCF(T3,3) E/**/F                                          \
 G/**/F(NAME)CCF(T1,1),CCF(T2,2),CCF(T3,3) JCF(T1,1) JCF(T2,2) JCF(T3,3));     \
 WCF(T1,1) WCF(T2,2) WCF(T3,3) X/**/F}

#define PROTOCCALLSFFUN4(F,NAME,T1,T2,T3,T4)                                   \
U/**/F C_(NAME)();                                                             \
static U/**/F CFFUN(NAME)(U/**/T1 A1,U/**/T2 A2,U/**/T3 A3,U/**/T4 A4          \
                          H/**/T1(C1) H/**/T2(C2) H/**/T3(C3) H/**/T4(C4))     \
{VCF(T1,1) VCF(T2,2) VCF(T3,3) VCF(T4,4) E/**/F                                \
 G/**/F(NAME)CCF(T1,1),CCF(T2,2),CCF(T3,3),CCF(T4,4) JCF(T1,1) JCF(T2,2)       \
 JCF(T3,3) JCF(T4,4)); WCF(T1,1) WCF(T2,2) WCF(T3,3) WCF(T4,4) X/**/F}

#define PROTOCCALLSFFUN5(F,NAME,T1,T2,T3,T4,T5)                                \
U/**/F C_(NAME)();                                                             \
static U/**/F CFFUN(NAME)(U/**/T1 A1,U/**/T2 A2,U/**/T3 A3,U/**/T4 A4,         \
   U/**/T5 A5 H/**/T1(C1) H/**/T2(C2) H/**/T3(C3) H/**/T4(C4) H/**/T5(C5))     \
{VCF(T1,1) VCF(T2,2) VCF(T3,3) VCF(T4,4) VCF(T5,5) E/**/F                      \
 G/**/F(NAME)CCF(T1,1),CCF(T2,2),CCF(T3,3),CCF(T4,4),CCF(T5,5)                 \
 JCF(T1,1) JCF(T2,2) JCF(T3,3) JCF(T4,4) JCF(T5,5));                           \
 WCF(T1,1) WCF(T2,2) WCF(T3,3) WCF(T4,4) WCF(T5,5) X/**/F}

#define PROTOCCALLSFFUN6(F,NAME,T1,T2,T3,T4,T5,T6)                             \
U/**/F C_(NAME)();                                                             \
static U/**/F CFFUN(NAME)(U/**/T1 A1,U/**/T2 A2,U/**/T3 A3,U/**/T4 A4,         \
                          U/**/T5 A5,U/**/T6 A6 H/**/T1(C1) H/**/T2(C2)        \
                        H/**/T3(C3) H/**/T4(C4) H/**/T5(C5) H/**/T6(C6))       \
{VCF(T1,1) VCF(T2,2) VCF(T3,3) VCF(T4,4) VCF(T5,5) VCF(T6,6) E/**/F            \
 G/**/F(NAME)CCF(T1,1),CCF(T2,2),CCF(T3,3),CCF(T4,4),CCF(T5,5),CCF(T6,6)       \
 JCF(T1,1) JCF(T2,2) JCF(T3,3) JCF(T4,4) JCF(T5,5) JCF(T6,6));                 \
 WCF(T1,1) WCF(T2,2) WCF(T3,3) WCF(T4,4) WCF(T5,5) WCF(T6,6) X/**/F}

#define PROTOCCALLSFFUN7(F,NAME,T1,T2,T3,T4,T5,T6,T7)                          \
U/**/F C_(NAME)();                                                             \
static U/**/F CFFUN(NAME)(U/**/T1 A1,U/**/T2 A2,U/**/T3 A3,U/**/T4 A4,         \
                          U/**/T5 A5,U/**/T6 A6,U/**/T7 A7 H/**/T1(C1)         \
  H/**/T2(C2) H/**/T3(C3) H/**/T4(C4) H/**/T5(C5) H/**/T6(C6) H/**/T7(C7))     \
{VCF(T1,1) VCF(T2,2) VCF(T3,3) VCF(T4,4) VCF(T5,5) VCF(T6,6) VCF(T7,7) E/**/F  \
 G/**/F(NAME)CCF(T1,1),CCF(T2,2),CCF(T3,3),CCF(T4,4),CCF(T5,5),CCF(T6,6),      \
             CCF(T7,7)                                                         \
 JCF(T1,1) JCF(T2,2) JCF(T3,3) JCF(T4,4) JCF(T5,5) JCF(T6,6) JCF(T7,7));       \
 WCF(T1,1) WCF(T2,2) WCF(T3,3) WCF(T4,4) WCF(T5,5) WCF(T6,6) WCF(T7,7) X/**/F}

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

/*               UTILITIES FOR FORTRAN TO CALL C ROUTINES                  */

/* Define lookup tables for how to handle the various types of variables.  */
#define FZDOUBLE(   A) double A(
#define FZFLOAT(    A) float  A(
#define FZINT(      A) int    A(
#define FZLOGICAL(  A) int    A(
#define FZLONG(     A) long   A(
#define FZSTRING(   A) void   A(char *AS, unsigned D0
#define FZVOID(     A) void   A(

#define FDOUBLE(    A) double A(
#define FFLOAT(     A) float  A(
#define FINT(       A) int    A(
#define FLOGICAL(   A) int    A(
#define FLONG(      A) long   A(
#define FSTRING(    A) FZSTRING(A),
#define FVOID(      A) void   A(

#define DDOUBLE(    A)
#define DFLOAT(     A)
#define DINT(       A)
#define DLOGICAL(   A)
#define DLONG(      A)
#define DSTRING(    A) ,unsigned A
#define DDOUBLEV(   A)
#define DFLOATV(    A)
#define DINTV(      A)
#define DSTRINGV(   A) ,unsigned A
#define DDOUBLEVV(  A)
#define DFLOATVV(   A)
#define DINTVV(     A)
#define DPDOUBLE(   A)
#define DPFLOAT(    A)
#define DPINT(      A)
#define DPLOGICAL(  A)
#define DPLONG(     A)
#define DPSTRING(   A) ,unsigned A
#define DPSTRINGV(  A) ,unsigned A
#define DPVOID(     A)

#define QDOUBLE(    A)
#define QFLOAT(     A)
#define QINT(       A)
#define QLOGICAL(   A)
#define QLONG(      A)
#define QSTRING(    A) char *A;
#define QDOUBLEV(   A)
#define QFLOATV(    A)
#define QINTV(      A)
#define QSTRINGV(   A) char *A; unsigned int A/**/N;
#define QDOUBLEVV(  A)
#define QFLOATVV(   A)
#define QINTVV(     A)
#define QPDOUBLE(   A)
#define QPFLOAT(    A)
#define QPINT(      A)
#define QPLOGICAL(  A)
#define QPLONG(     A)
#define QPSTRING(   A) char *A;
#define QPSTRINGV      QSTRINGV
#define QPVOID(     A)

#define LDOUBLE(NAME)  A0=ccallsc(NAME)
#define LFLOAT(NAME)   A0=ccallsc(NAME)
#define LINT(NAME)     A0=ccallsc(NAME)
#define LLOGICAL(NAME) A0=ccallsc(NAME)
#define LLONG(NAME)    A0=ccallsc(NAME)
#define LSTRING(NAME)  A0=ccallsc(NAME)
#define LVOID(NAME)       ccallsc(NAME)

#define TCF(NAME,TN,I)     T/**/TN(NAME,A/**/I,B/**/I,D/**/I)
#define TDOUBLE(  M,A,B,D) *A
#define TFLOAT(   M,A,B,D) *A
#define TINT(     M,A,B,D) *A
#define TLOGICAL( M,A,B,D) *A
#define TLONG(    M,A,B,D) *A
#define TSTRING(  M,A,B,D) (memcpy(B=malloc(D+1),A,D),B[D]='\0',               \
                                                     kill_trailing(B,' '))
#define TDOUBLEV( M,A,B,D)  A
#define TFLOATV(  M,A,B,D)  A
#define TINTV(    M,A,B,D)  A
#define TSTRINGV( M,A,B,D) (B/**/N=num_elem(A,D,M/**/_STRV_/**/A),             \
     (void *)vkill_trailing(f2cstrv(A,B=malloc(B/**/N*(D+1)),D+1,B/**/N*(D+1)),\
                            D+1,B/**/N*(D+1),' '))
#define TDOUBLEVV(M,A,B,D)  A
#define TFLOATVV( M,A,B,D)  A
#define TINTVV(   M,A,B,D)  A
#define TPDOUBLE( M,A,B,D)  A
#define TPFLOAT(  M,A,B,D)  A
#define TPINT(    M,A,B,D)  A
#define TPLOGICAL(M,A,B,D)  A
#define TPLONG(   M,A,B,D)  A
#define TPSTRING           TSTRING         
#define TPSTRINGV          TSTRINGV         
#define TPVOID(   M,A,B,D)  A

#define KDOUBLE
#define KFLOAT
#define KINT
#define KLOGICAL
#define KLONG
#define KSTRING  memcpy(AS,A0, MIN(D0,(A0==NULL?0:strlen(A0))) );              \
                 D0>(A0==NULL?0:strlen(A0))?memset(AS+(A0==NULL?0:strlen(A0)), \
                                            ' ', D0-(A0==NULL?0:strlen(A0))):0;
/* The above line copies the string into the position provided by the caller. */
#define KVOID

#define RCF(TN,I)          R/**/TN(A/**/I,B/**/I,D/**/I)
#define RDOUBLE(  A,B,D)
#define RFLOAT(   A,B,D)
#define RINT(     A,B,D)
#define RLOGICAL( A,B,D)
#define RLONG(    A,B,D)
#define RSTRING(  A,B,D)   free(B);
#define RDOUBLEV( A,B,D)
#define RFLOATV(  A,B,D)
#define RINTV(    A,B,D)
#define RSTRINGV( A,B,D)   free(B);
#define RDOUBLEVV(A,B,D)
#define RFLOATVV( A,B,D)
#define RINTVV(   A,B,D)
#define RPDOUBLE( A,B,D)
#define RPFLOAT(  A,B,D)
#define RPINT(    A,B,D)
#define RPLOGICAL(A,B,D)
#define RPLONG(   A,B,D)
#define RPSTRING( A,B,D)   memcpy(A,B,MIN(strlen(B),D)),                       \
                  (D>strlen(B)?memset(A+strlen(B),' ', D-strlen(B)):0), free(B);
#define RPSTRINGV(A,B,D) c2fstrv(B,A,D+1,(D+1)*B/**/N), free(B);
#define RPVOID(   A,B,D)

#define IDOUBLE        return A0;
#define IFLOAT         return A0;
#define IINT           return A0;
#define ILOGICAL       return A0;
#define ILONG          return A0;
#define ISTRING        return;
#define IVOID          return;

#define FCALLSCSUB0(NAME)                FCALLSCFUN0(VOID,NAME)
#define FCALLSCSUB1(NAME,T1)             FCALLSCFUN1(VOID,NAME,T1)
#define FCALLSCSUB2(NAME,T1,T2)          FCALLSCFUN2(VOID,NAME,T1,T2)
#define FCALLSCSUB3(NAME,T1,T2,T3)       FCALLSCFUN3(VOID,NAME,T1,T2,T3)
#define FCALLSCSUB4(NAME,T1,T2,T3,T4)    FCALLSCFUN4(VOID,NAME,T1,T2,T3,T4)
#define FCALLSCSUB5(NAME,T1,T2,T3,T4,T5) FCALLSCFUN5(VOID,NAME,T1,T2,T3,T4,T5)
#define FCALLSCSUB6(NAME,T1,T2,T3,T4,T5,T6)                                    \
                               FCALLSCFUN6(VOID,NAME,T1,T2,T3,T4,T5,T6)       
#define FCALLSCSUB7(NAME,T1,T2,T3,T4,T5,T6,T7)                                 \
                               FCALLSCFUN7(VOID,NAME,T1,T2,T3,T4,T5,T6,T7)
#define FCALLSCSUB8(NAME,T1,T2,T3,T4,T5,T6,T7,T8)                              \
                               FCALLSCFUN8(VOID,NAME,T1,T2,T3,T4,T5,T6,T7,T8)
#define FCALLSCSUB9(NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9)                           \
                               FCALLSCFUN9(VOID,NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9)

#define FCALLSCFUN0(T0,NAME)                                                   \
FZ/**/T0(C_(NAME)))                                                            \
{U/**/T0 A0; L/**/T0(NAME)(); K/**/T0 I/**/T0}

#define FCALLSCFUN1(T0,NAME,T1)                                                \
F/**/T0(C_(NAME))N/**/T1 A1 D/**/T1(D1)) {U/**/T0 A0; Q/**/T1(B1)              \
 L/**/T0(NAME)(TCF(NAME,T1,1)); K/**/T0 RCF(T1,1) I/**/T0}

#define FCALLSCFUN2(T0,NAME,T1,T2)                                             \
F/**/T0(C_(NAME))N/**/T1 A1,N/**/T2 A2 D/**/T1(D1) D/**/T2(D2))                \
{U/**/T0 A0; Q/**/T1(B1) Q/**/T2(B2)                                           \
 L/**/T0(NAME)(TCF(NAME,T1,1),TCF(NAME,T2,2));K/**/T0 RCF(T1,1)RCF(T2,2)I/**/T0}

#define FCALLSCFUN3(T0,NAME,T1,T2,T3)                                          \
F/**/T0(C_(NAME))N/**/T1 A1,N/**/T2 A2,N/**/T3 A3 D/**/T1(D1) D/**/T2(D2)      \
 D/**/T3(D3)) {U/**/T0 A0; Q/**/T1(B1) Q/**/T2(B2) Q/**/T3(B3)                 \
 L/**/T0(NAME)(TCF(NAME,T1,1),TCF(NAME,T2,2),TCF(NAME,T3,3));                  \
 K/**/T0 RCF(T1,1) RCF(T2,2) RCF(T3,3) I/**/T0}

#define FCALLSCFUN4(T0,NAME,T1,T2,T3,T4)                                       \
F/**/T0(C_(NAME))N/**/T1 A1,N/**/T2 A2,N/**/T3 A3,N/**/T4 A4 D/**/T1(D1)       \
 D/**/T2(D2) D/**/T3(D3) D/**/T4(D4)) {U/**/T0 A0; Q/**/T1(B1) Q/**/T2(B2)     \
 Q/**/T3(B3) Q/**/T4(B4) L/**/T0(NAME)(TCF(NAME,T1,1),TCF(NAME,T2,2),          \
 TCF(NAME,T3,3),TCF(NAME,T4,4)); K/**/T0 RCF(T1,1)RCF(T2,2) RCF(T3,3) RCF(T4,4)\
 I/**/T0}

#define FCALLSCFUN5(T0,NAME,T1,T2,T3,T4,T5)                                    \
F/**/T0(C_(NAME))N/**/T1 A1,N/**/T2 A2,N/**/T3 A3,N/**/T4 A4,N/**/T5 A5        \
 D/**/T1(D1) D/**/T2(D2) D/**/T3(D3) D/**/T4(D4) D/**/T5(D5)) {U/**/T0 A0;     \
 Q/**/T1(B1) Q/**/T2(B2) Q/**/T3(B3) Q/**/T4(B4) Q/**/T5(B5)                   \
 L/**/T0(NAME)(TCF(NAME,T1,1),TCF(NAME,T2,2),TCF(NAME,T3,3),TCF(NAME,T4,4),    \
 TCF(NAME,T5,5)); K/**/T0 RCF(T1,1)RCF(T2,2)RCF(T3,3)RCF(T4,4)RCF(T5,5) I/**/T0}

#define FCALLSCFUN6(T0,NAME,T1,T2,T3,T4,T5,T6)                                 \
F/**/T0(C_(NAME))N/**/T1 A1,N/**/T2 A2,N/**/T3 A3,N/**/T4 A4,N/**/T5 A5,       \
 N/**/T6 A6 D/**/T1(D1) D/**/T2(D2) D/**/T3(D3) D/**/T4(D4) D/**/T5(D5)        \
 D/**/T6(D6)) {U/**/T0 A0; Q/**/T1(B1) Q/**/T2(B2) Q/**/T3(B3) Q/**/T4(B4)     \
 Q/**/T5(B5) Q/**/T6(B6) L/**/T0(NAME)(TCF(NAME,T1,1),TCF(NAME,T2,2),          \
 TCF(NAME,T3,3),TCF(NAME,T4,4),TCF(NAME,T5,5),TCF(NAME,T6,6)); K/**/T0         \
 RCF(T1,1) RCF(T2,2) RCF(T3,3) RCF(T4,4) RCF(T5,5) RCF(T6,6) I/**/T0}

#define FCALLSCFUN7(T0,NAME,T1,T2,T3,T4,T5,T6,T7)                              \
F/**/T0(C_(NAME))N/**/T1 A1,N/**/T2 A2,N/**/T3 A3,N/**/T4 A4,N/**/T5 A5,       \
 N/**/T6 A6 N/**/T7 A7 D/**/T1(D1) D/**/T2(D2) D/**/T3(D3) D/**/T4(D4)         \
 D/**/T5(D5) D/**/T6(D6) D/**/T7(D7)) {U/**/T0 A0; Q/**/T1(B1) Q/**/T2(B2)     \
 Q/**/T3(B3) Q/**/T4(B4) Q/**/T5(B5) Q/**/T6(B6) Q/**/T7(B7)                   \
 L/**/T0(NAME)(TCF(NAME,T1,1),TCF(NAME,T2,2),TCF(NAME,T3,3),TCF(NAME,T4,4),    \
 TCF(NAME,T5,5),TCF(NAME,T6,6),TCF(NAME,T7,7)); K/**/T0                        \
 RCF(T1,1) RCF(T2,2) RCF(T3,3) RCF(T4,4) RCF(T5,5) RCF(T6,6) RCF(T7,7) I/**/T0}

#define FCALLSCFUN8(T0,NAME,T1,T2,T3,T4,T5,T6,T7,T8)                           \
F/**/T0(C_(NAME))N/**/T1 A1,N/**/T2 A2,N/**/T3 A3,N/**/T4 A4,N/**/T5 A5,       \
 N/**/T6 A6 N/**/T7 A7 N/**/T8 A8 D/**/T1(D1) D/**/T2(D2) D/**/T3(D3)          \
 D/**/T4(D4) D/**/T5(D5) D/**/T6(D6) D/**/T7(D7) D/**/T8(D8)) {U/**/T0 A0;     \
 Q/**/T1(B1) Q/**/T2(B2) Q/**/T3(B3) Q/**/T4(B4) Q/**/T5(B5) Q/**/T6(B6)       \
 Q/**/T7(B7) Q/**/T8(B8) L/**/T0(NAME)(TCF(NAME,T1,1),TCF(NAME,T2,2),          \
 TCF(NAME,T3,3),TCF(NAME,T4,4),TCF(NAME,T5,5),TCF(NAME,T6,6),TCF(NAME,T7,7),   \
 TCF(NAME,T8,8)); K/**/T0 RCF(T1,1) RCF(T2,2) RCF(T3,3) RCF(T4,4) RCF(T5,5)    \
 RCF(T6,6) RCF(T7,7) RCF(T8,8) I/**/T0}

#define FCALLSCFUN9(T0,NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9)                        \
F/**/T0(C_(NAME))N/**/T1 A1,N/**/T2 A2,N/**/T3 A3,N/**/T4 A4,N/**/T5 A5,       \
 N/**/T6 A6 N/**/T7 A7 N/**/T8 A8 N/**/T9 A9 D/**/T1(D1) D/**/T2(D2)           \
 D/**/T3(D3) D/**/T4(D4) D/**/T5(D5) D/**/T6(D6) D/**/T7(D7) D/**/T8(D8)       \
 D/**/T8(D8) D/**/T9(D9)) {U/**/T0 A0; Q/**/T1(B1) Q/**/T2(B2) Q/**/T3(B3)     \
 Q/**/T4(B4) Q/**/T5(B5) Q/**/T6(B6) Q/**/T7(B7) Q/**/T8(B8) Q/**/T9(B9)       \
 L/**/T0(NAME)(TCF(NAME,T1,1),TCF(NAME,T2,2),TCF(NAME,T3,3),TCF(NAME,T4,4),    \
 TCF(NAME,T5,5),TCF(NAME,T6,6),TCF(NAME,T7,7),TCF(NAME,T8,8),TCF(NAME,T9,9));  \
 K/**/T0 RCF(T1,1) RCF(T2,2) RCF(T3,3) RCF(T4,4) RCF(T5,5)                     \
 RCF(T6,6) RCF(T7,7) RCF(T8,8) RCF(T9,9) I/**/T0}


#endif				       /* __CFORTRAN_LOADED */
#endif                                 /* This for MIPS && RS/6000 compilers. */
--------------cut for cfortran_vms.h----------------------------------
/* cfortran.h */
/* Burkhard Burow, University of Toronto, July 1991. */

#ifndef __CFORTRAN_LOADED
#define __CFORTRAN_LOADED	1

#ifndef vms
??=error This header file is for VAX VMS C compilers only. 
#else

#include <descrip.h>
#include <stddef.h>
#include <stdlib.h>
#include <string.h>
/*-------------------------------------------------------------------------*/

/*               UTILITIES USED WITHIN CFORTRAN                            */

#define MIN(A,B) (A<B?A:B)
#define firstindexlength(A) (sizeof(A)/sizeof(A[0]))
#define secondindexlength(A) (sizeof((A)[0])/sizeof((A)[0][0]))
#define COMMON_BLOCK(C)        C
#define C_FUNCTION(NAME)       fcallsc(NAME)
#define FORTRAN_FUNCTION(NAME) ccallsc(NAME)

typedef struct dsc$descriptor_s fstring;
#define DSC$DESCRIPTOR_A(DIMCT)  		                               \
struct {                                                                       \
  unsigned short dsc$w_length;	                                               \
  unsigned char	 dsc$b_dtype;	                                               \
  unsigned char	 dsc$b_class;	                                               \
           char	*dsc$a_pointer;	                                               \
           char	 dsc$b_scale;	                                               \
  unsigned char	dsc$b_digits;	                                               \
  struct {                                                                     \
    unsigned		       : 3;	                                       \
    unsigned dsc$v_fl_binscale : 1;                                            \
    unsigned dsc$v_fl_redim    : 1;                                            \
    unsigned dsc$v_fl_column   : 1;                                            \
    unsigned dsc$v_fl_coeff    : 1;                                            \
    unsigned dsc$v_fl_bounds   : 1;                                            \
  } dsc$b_aflags;	                                                       \
  unsigned char	 dsc$b_dimct;	                                               \
  unsigned long	 dsc$l_arsize;	                                               \
           char	*dsc$a_a0;	                                               \
           long	 dsc$l_m [DIMCT];                                              \
  struct {                                                                     \
    long dsc$l_l;                                                              \
    long dsc$l_u;                                                              \
  } dsc$bounds [DIMCT];                                                        \
}
typedef DSC$DESCRIPTOR_A(1) fstringvector;
/*typedef DSC$DESCRIPTOR_A(2) fstringarrarr;
  typedef DSC$DESCRIPTOR_A(3) fstringarrarrarr;*/
#define initfstr(F,C,ELEMNO,ELEMLEN)                                           \
( (F).dsc$l_arsize=  ( (F).dsc$w_length                        =(ELEMLEN) )    \
                    *( (F).dsc$l_m[0]=(F).dsc$bounds[0].dsc$l_u=(ELEMNO)  ),   \
  (F).dsc$a_a0    =  ( (F).dsc$a_pointer=(C) ) - (F).dsc$w_length          ,(F))

/* Convert a vector of C strings into FORTRAN strings. */
static char *c2fstrv(char* cstr, char *fstr, int elem_len, int sizeofcstr)
{ int i,j;
/* elem_len includes \0 for C strings. Fortran strings don't have term. \0.
   Useful size of string must be the same in both languages. */
for (i=0; i<sizeofcstr/elem_len; i++) {
  for (j=1; j<elem_len && *cstr; j++) *fstr++ = *cstr++;
  cstr += 1+elem_len-j;
  for (; j<elem_len; j++) *fstr++ = ' ';
}
return fstr-sizeofcstr+sizeofcstr/elem_len;
}

/* Convert a vector of FORTRAN strings into C strings. */
static char *f2cstrv(char *fstr, char* cstr, int elem_len, int sizeofcstr)
{ int i,j;
/* elem_len includes \0 for C strings. Fortran strings don't have term. \0.
   Useful size of string must be the same in both languages. */
cstr += sizeofcstr;
fstr += sizeofcstr - sizeofcstr/elem_len;
for (i=0; i<sizeofcstr/elem_len; i++) {
  *--cstr = '\0';
  for (j=1; j<elem_len; j++) *--cstr = *--fstr;
}
return cstr;
}

/* kill the trailing char t's in string s. */
static char *kill_trailing(char *s, char t)
{char *e; 
e = s + strlen(s);
if (e>s) {                           /* Need this to handle NULL string.*/
  while (e>s && *--e==t);            /* Don't follow t's past beginning. */
  e[*e==t?0:1] = '\0';               /* Handle s[0]=t correctly.       */
}
return s;
}

/* kill_trailingn(s,t,e) will kill the trailing t's in string s. e normally 
points to the terminating '\0' of s, but may actually point to anywhere in s.
s's new '\0' will be placed at e or earlier in order to remove any trailing t's.
If e<s string s is left unchanged. */ 
static char *kill_trailingn(char *s, char t, char *e)
{ 
if (e==s) *e = '\0';                 /* Kill the string makes sense here.*/
else if (e>s) {                      /* Watch out for neg. length string.*/
  while (e>s && *--e==t);            /* Don't follow t's past beginning. */
  e[*e==t?0:1] = '\0';               /* Handle s[0]=t correctly.       */
}
return s;
}

/* Note the following assumes that any element which has t's to be chopped off,
does indeed fill the entire element. */
static char *vkill_trailing(char* cstr, int elem_len, int sizeofcstr, char t)
{ int i;
for (i=0; i<sizeofcstr/elem_len; i++) /* elem_len includes \0 for C strings. */
  kill_trailingn(cstr+elem_len*i,t,cstr+elem_len*(i+1)-1);
return cstr;
}

static char *f2cstrvcopy(char *cstr, fstringvector *f)
{
unsigned i, elem_len;
elem_len = f->dsc$w_length + 1;
/* copy each element and tack the terminating \0 onto each element and kill
   trailing blanks. */
for (i=0; i < f->dsc$l_m[0];) {
  memcpy(cstr + (elem_len*i), f->dsc$a_pointer + (f->dsc$w_length*i), 
         f->dsc$w_length);
  *(cstr + elem_len*(++i) - 1) = '\0';
  kill_trailing(cstr + elem_len*(i-1),' ');
}
return(cstr);
}

static fstringvector *c2fstrvcopy(char *cstr, fstringvector *f, 
                                  unsigned elem_len)
{
unsigned i;
/* copy each element but not its last \0 */
for (i=0; i < f->dsc$l_m[0]; i++) 
  memcpy(f->dsc$a_pointer + (f->dsc$w_length*i), 
         cstr + (elem_len*i), f->dsc$w_length);
/*convert the remaining \0's into 'blank's */
for (i=0; i < f->dsc$l_arsize; i++) 
  if (f->dsc$a_pointer[i] == '\0') f->dsc$a_pointer[i] = ' ';
return(f);
}

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

/*               UTILITIES FOR C TO CALL FORTRAN SUBROUTINES               */

/* Define lookup tables for how to handle the various types of variables.  */
/* Note that the VMS compiler issues warnings if all arguments to a macro
   aren't used. Therefore some of the definitions below, as marked, are dummy.
 Q: Why the (char *) cast for STRING?                                      */
#define VCF(TN,I)      V/**/TN(A/**/I,B/**/I)
#define VDOUBLE(  A,B) double B = A;
#define VFLOAT(   A,B) float  B = A;
#define VINT(     A,B) int    B = (int)A;      /* typecast for enum's sake */
#define VLOGICAL( A,B) int    B = A;
#define VLONG(    A,B) long   B = A;
/* The sizeof(A) below is just to use A as reqd. by VMS C. */
#define VSTRING(  A,B) static struct {fstring f; unsigned clen;} B =           \
                               {{sizeof(A),DSC$K_DTYPE_T,DSC$K_CLASS_S,NULL},0};
#define VDOUBLEV( A,B) double *B = A;
#define VFLOATV(  A,B) float *B = A;
#define VINTV(    A,B) int   *B = A;
/* The sizeof(A) below is just to use A as reqd. by VMS C. */
#define VSTRINGV( A,B) static fstringvector B =                                \
{sizeof(A),DSC$K_DTYPE_T,DSC$K_CLASS_A,NULL,0,0,{0,0,0,1,1,1},1,0,NULL,0,{1,0}};
#define VFLOATVV( A,B) float *B = A[0];
#define VINTVV(   A,B) int   *B = A[0];
#define VPDOUBLE( A,B) void  *B = &A;             /* dummy */
#define VPFLOAT(  A,B) void  *B = &A;             /* dummy */
#define VPINT(    A,B) void  *B = (int *)& A;     /* dummy */
#define VPLOGICAL(A,B) void  *B = &A;             /* dummy */
#define VPLONG(   A,B) void  *B = &A;             /* dummy */
/* The sizeof(A) in VPSTRING(V) is just to use A as reqd. by VMS C. */
#define VPSTRING( A,B) static fstring B =                                      \
                                   {sizeof(A),DSC$K_DTYPE_T,DSC$K_CLASS_S,NULL};
#define VPSTRINGV(A,B) static fstringvector B =                                \
{sizeof(A),DSC$K_DTYPE_T,DSC$K_CLASS_A,NULL,0,0,{0,0,0,1,1,1},1,0,NULL,0,{1,0}};
#define VPVOID(   A,B) void  *B = A; 
#define VPSTRUCT( A,B) void  *B = (void *)&A;     /* dummy */

/* N.B. The first of the following two expressions is a dummy so that the
   VMS compiler does not complain that both arguments aren't used. */
#define ADOUBLE(  A,B) (A,&B)
#define AFLOAT(   A,B) (A,&B)
#define AINT(     A,B) (A,&B)
#define ALOGICAL( A,B) (A,&B)
#define ALONG(    A,B) (A,&B)
#define ASTRING(  A,B) CSTRING(A,B,sizeof(A))
#define ADOUBLEV( A,B) (A,B)
#define AFLOATV(  A,B) (A,B)
#define AINTV(    A,B) (A,B)
#define ASTRINGV( A,B) (initfstr(B,malloc(sizeof(A)-firstindexlength(A)),      \
                                 firstindexlength(A),secondindexlength(A)-1),  \
                c2fstrv(A[0],B.dsc$a_pointer,secondindexlength(A),sizeof(A)),&B)
#define AFLOATVV( A,B) (A,B)
#define AINTVV(   A,B) (A,B)
#define APDOUBLE( A,B) (B,& A)
#define APFLOAT(  A,B) (B,& A)
#define APINT(    A,B) (B,& A) /* no longer typecast for enum */
#define APLOGICAL(A,B) (B,& A)
#define APLONG(   A,B) (B,& A)
#define APSTRING( A,B) CPSTRING(A,B,sizeof(A))
#define APSTRINGV(A,B) (initfstr(B,A[0],firstindexlength(A),                   \
                                 secondindexlength(A)-1),                      \
                        c2fstrv(A[0],A[0],secondindexlength(A),sizeof(A)), &B)
#define APVOID(   A,B) (A, B) /* this allows 0 to be passed */
#define APSTRUCT( A,B) (B,&A)

/* N.B. Other than for PSTRING and PSTRINGV the following expressions are dummy
 so that the VMS compiler does not complain that the argument isn't used. */
#define WCF(TN,I)      W/**/TN(A/**/I,B/**/I)
#define WDOUBLE(  A,B) B,A;
#define WFLOAT(   A,B) B,A;
#define WINT(     A,B) B,A;
#define WLOGICAL( A,B) B,A;
#define WLONG(    A,B) B,A;
#define WSTRING(  A,B) (A[B.clen]!='\0'?A[B.clen]='\0':0);
#define WDOUBLEV( A,B) B,A;
#define WFLOATV(  A,B) B,A;
#define WINTV(    A,B) B,A;
#define WSTRINGV( A,B) A,free(B.dsc$a_pointer);
#define WFLOATVV( A,B) B,A;
#define WINTVV(   A,B) B,A;
#define WPDOUBLE( A,B) B,A;
#define WPFLOAT(  A,B) B,A;
#define WPINT(    A,B) B,A;
#define WPLOGICAL(A,B) B,A;
#define WPLONG(   A,B) B,A;
#define WPSTRING( A,B) B,kill_trailing(A,' ');
#define WPSTRINGV(A,B)                                                         \
  vkill_trailing(f2cstrv((char*)A, (char*)A,                                   \
                         B.dsc$w_length+1, B.dsc$l_arsize+B.dsc$l_m[0]),       \
                 B.dsc$w_length+1, B.dsc$l_arsize+B.dsc$l_m[0], ' ');
#define WPVOID(   A,B) B,A;
#define WPSTRUCT( A,B) B,A;

#define NDOUBLE        double        *
#define NFLOAT         float         *
#define NINT           int           *
#define NLOGICAL       int           *
#define NLONG          long          *
#define NSTRING        fstring       *
#define NDOUBLEV       double        *
#define NFLOATV        float         *
#define NINTV          int           *
#define NSTRINGV       fstringvector *
#define NFLOATVV       float         *
#define NINTVV         int           *
#define NPDOUBLE       double        *
#define NPFLOAT        float         *
#define NPINT          int           *
#define NPLOGICAL      int           *
#define NPLONG         long          *
#define NPSTRING       fstring       *
#define NPSTRINGV      fstringvector *
#define NPVOID         void          *
#define NPSTRUCT       void          *

#define CCALLSFSUB0(NAME) {NAME();}

#define CCALLSFSUB1(NAME,T1,A1)                                                \
{V/**/T1(A1,B1) NAME(A/**/T1(A1,B1)); W/**/T1(A1,B1)}

#define CCALLSFSUB2(NAME,T1,T2,A1,A2)                                          \
{V/**/T1(A1,B1) V/**/T2(A2,B2) NAME(A/**/T1(A1,B1),A/**/T2(A2,B2));            \
 W/**/T1(A1,B1) W/**/T2(A2,B2)}

#define CCALLSFSUB3(NAME,T1,T2,T3,A1,A2,A3)                                    \
{V/**/T1(A1,B1) V/**/T2(A2,B2) V/**/T3(A3,B3)                                  \
 NAME(A/**/T1(A1,B1),A/**/T2(A2,B2),A/**/T3(A3,B3));                           \
 W/**/T1(A1,B1) W/**/T2(A2,B2) W/**/T3(A3,B3)}

#define CCALLSFSUB4(NAME,T1,T2,T3,T4,A1,A2,A3,A4)                              \
{V/**/T1(A1,B1) V/**/T2(A2,B2) V/**/T3(A3,B3) V/**/T4(A4,B4)                   \
 NAME(A/**/T1(A1,B1),A/**/T2(A2,B2),A/**/T3(A3,B3),A/**/T4(A4,B4));            \
 W/**/T1(A1,B1) W/**/T2(A2,B2) W/**/T3(A3,B3) W/**/T4(A4,B4)}

#define CCALLSFSUB5(NAME,T1,T2,T3,T4,T5,A1,A2,A3,A4,A5)                        \
{V/**/T1(A1,B1) V/**/T2(A2,B2) V/**/T3(A3,B3) V/**/T4(A4,B4) V/**/T5(A5,B5)    \
 NAME(A/**/T1(A1,B1),A/**/T2(A2,B2),A/**/T3(A3,B3),A/**/T4(A4,B4),             \
      A/**/T5(A5,B5));                                                         \
 W/**/T1(A1,B1) W/**/T2(A2,B2) W/**/T3(A3,B3) W/**/T4(A4,B4) W/**/T5(A5,B5)}

#define CCALLSFSUB6(NAME,T1,T2,T3,T4,T5,T6,A1,A2,A3,A4,A5,A6)                  \
{V/**/T1(A1,B1) V/**/T2(A2,B2) V/**/T3(A3,B3) V/**/T4(A4,B4)                   \
 V/**/T5(A5,B5) V/**/T6(A6,B6)                                                 \
 NAME(A/**/T1(A1,B1),A/**/T2(A2,B2),A/**/T3(A3,B3),A/**/T4(A4,B4),             \
      A/**/T5(A5,B5),A/**/T6(A6,B6));                                          \
 W/**/T1(A1,B1) W/**/T2(A2,B2) W/**/T3(A3,B3) W/**/T4(A4,B4) W/**/T5(A5,B5)    \
 W/**/T6(A6,B6)}

#define CCALLSFSUB7(NAME,T1,T2,T3,T4,T5,T6,T7,A1,A2,A3,A4,A5,A6,A7)            \
{V/**/T1(A1,B1) V/**/T2(A2,B2) V/**/T3(A3,B3) V/**/T4(A4,B4)                   \
 V/**/T5(A5,B5) V/**/T6(A6,B6) V/**/T7(A7,B7)                                  \
 NAME(A/**/T1(A1,B1),A/**/T2(A2,B2),A/**/T3(A3,B3),A/**/T4(A4,B4),             \
      A/**/T5(A5,B5),A/**/T6(A6,B6),A/**/T7(A7,B7));                           \
 W/**/T1(A1,B1) W/**/T2(A2,B2) W/**/T3(A3,B3) W/**/T4(A4,B4) W/**/T5(A5,B5)    \
 W/**/T6(A6,B6) W/**/T7(A7,B7)}

#define CCALLSFSUB8(NAME,T1,T2,T3,T4,T5,T6,T7,T8,A1,A2,A3,A4,A5,A6,A7,A8)      \
{V/**/T1(A1,B1) V/**/T2(A2,B2) V/**/T3(A3,B3) V/**/T4(A4,B4)                   \
 V/**/T5(A5,B5) V/**/T6(A6,B6) V/**/T7(A7,B7) V/**/T8(A8,B8)                   \
 NAME(A/**/T1(A1,B1),A/**/T2(A2,B2),A/**/T3(A3,B3),A/**/T4(A4,B4),             \
      A/**/T5(A5,B5),A/**/T6(A6,B6),A/**/T7(A7,B7),A/**/T8(A8,B8));            \
 W/**/T1(A1,B1) W/**/T2(A2,B2) W/**/T3(A3,B3) W/**/T4(A4,B4) W/**/T5(A5,B5)    \
 W/**/T6(A6,B6) W/**/T7(A7,B7) W/**/T8(A8,B8)}

#define CCALLSFSUB9(NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9,A1,A2,A3,A4,A5,A6,A7,A8,A9)\
{V/**/T1(A1,B1) V/**/T2(A2,B2) V/**/T3(A3,B3) V/**/T4(A4,B4)                   \
 V/**/T5(A5,B5) V/**/T6(A6,B6) V/**/T7(A7,B7) V/**/T8(A8,B8) V/**/T9(A9,B9)    \
 NAME(A/**/T1(A1,B1),A/**/T2(A2,B2),A/**/T3(A3,B3),A/**/T4(A4,B4),             \
      A/**/T5(A5,B5),A/**/T6(A6,B6),A/**/T7(A7,B7),A/**/T8(A8,B8),             \
      A/**/T9(A9,B9));                                                         \
 W/**/T1(A1,B1) W/**/T2(A2,B2) W/**/T3(A3,B3) W/**/T4(A4,B4) W/**/T5(A5,B5)    \
 W/**/T6(A6,B6) W/**/T7(A7,B7) W/**/T8(A8,B8) W/**/T9(A9,B9)}

#define CCALLSFSUB10(NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,A1,A2,A3,A4,A5,A6,A7,  \
                                                        A8,A9,AA)              \
{V/**/T1(A1,B1) V/**/T2(A2,B2) V/**/T3(A3,B3) V/**/T4(A4,B4) V/**/T5(A5,B5)    \
 V/**/T6(A6,B6) V/**/T7(A7,B7) V/**/T8(A8,B8) V/**/T9(A9,B9) V/**/TA(AA,BA)    \
 NAME(A/**/T1(A1,B1),A/**/T2(A2,B2),A/**/T3(A3,B3),A/**/T4(A4,B4),             \
      A/**/T5(A5,B5),A/**/T6(A6,B6),A/**/T7(A7,B7),A/**/T8(A8,B8),             \
      A/**/T9(A9,B9),A/**/TA(AA,BA));                                          \
 W/**/T1(A1,B1) W/**/T2(A2,B2) W/**/T3(A3,B3) W/**/T4(A4,B4) W/**/T5(A5,B5)    \
 W/**/T6(A6,B6) W/**/T7(A7,B7) W/**/T8(A8,B8) W/**/T9(A9,B9) W/**/TA(AA,BA)}

#define CCALLSFSUB11(NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,A1,A2,A3,A4,A5,A6,  \
                                                        A7,A8,A9,AA,AB)        \
{V/**/T1(A1,B1) V/**/T2(A2,B2) V/**/T3(A3,B3) V/**/T4(A4,B4)                   \
 V/**/T5(A5,B5) V/**/T6(A6,B6) V/**/T7(A7,B7) V/**/T8(A8,B8) V/**/T9(A9,B9)    \
 V/**/TA(AA,BA) V/**/TB(AB,BB)                                                 \
 NAME(A/**/T1(A1,B1),A/**/T2(A2,B2),A/**/T3(A3,B3),A/**/T4(A4,B4),             \
      A/**/T5(A5,B5),A/**/T6(A6,B6),A/**/T7(A7,B7),A/**/T8(A8,B8),             \
      A/**/T9(A9,B9),A/**/TA(AA,BA),A/**/TB(AB,BB)); W/**/T1(A1,B1)            \
 W/**/T2(A2,B2) W/**/T3(A3,B3) W/**/T4(A4,B4) W/**/T5(A5,B5) W/**/T6(A6,B6)    \
 W/**/T7(A7,B7) W/**/T8(A8,B8) W/**/T9(A9,B9) W/**/TA(AA,BA) W/**/TB(AB,BB)}

#define CCALLSFSUB16(NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,     \
                          A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG)     \
{V/**/T1(A1,B1) V/**/T2(A2,B2) V/**/T3(A3,B3) V/**/T4(A4,B4) V/**/T5(A5,B5)    \
 V/**/T6(A6,B6) V/**/T7(A7,B7) V/**/T8(A8,B8) V/**/T9(A9,B9) V/**/TA(AA,BA)    \
 V/**/TB(AB,BB) V/**/TC(AC,BC) V/**/TD(AD,BD) V/**/TE(AE,BE) V/**/TF(AF,BF)    \
 V/**/TG(AG,BG)                                                                \
 NAME(A/**/T1(A1,B1),A/**/T2(A2,B2),A/**/T3(A3,B3),A/**/T4(A4,B4),             \
      A/**/T5(A5,B5),A/**/T6(A6,B6),A/**/T7(A7,B7),A/**/T8(A8,B8),             \
      A/**/T9(A9,B9),A/**/TA(AA,BA),A/**/TB(AB,BB),A/**/TC(AC,BC),             \
      A/**/TD(AD,BD),A/**/TE(AE,BE),A/**/TF(AF,BF),A/**/TG(AG,BG));            \
 W/**/T1(A1,B1) W/**/T2(A2,B2) W/**/T3(A3,B3) W/**/T4(A4,B4) W/**/T5(A5,B5)    \
 W/**/T6(A6,B6) W/**/T7(A7,B7) W/**/T8(A8,B8) W/**/T9(A9,B9) W/**/TA(AA,BA)    \
 W/**/TB(AB,BB) W/**/TC(AC,BC) W/**/TD(AD,BD) W/**/TE(AE,BE) W/**/TF(AF,BF)    \
 W/**/TG(AG,BG)}

#define PROTOCCALLSFSUB0(NAME) void NAME();
#define PROTOCCALLSFSUB1(NAME,T1) void NAME(N/**/T1);
#define PROTOCCALLSFSUB2(NAME,T1,T2) void NAME(N/**/T1,N/**/T2);
#define PROTOCCALLSFSUB3(NAME,T1,T2,T3) void NAME(N/**/T1,N/**/T2,N/**/T3);
#define PROTOCCALLSFSUB4(NAME,T1,T2,T3,T4)                                     \
                    void NAME(N/**/T1,N/**/T2,N/**/T3,N/**/T4);
#define PROTOCCALLSFSUB5(NAME,T1,T2,T3,T4,T5)                                  \
                    void NAME(N/**/T1,N/**/T2,N/**/T3,N/**/T4,N/**/T5);
#define PROTOCCALLSFSUB6(NAME,T1,T2,T3,T4,T5,T6)                               \
                    void NAME(N/**/T1,N/**/T2,N/**/T3,N/**/T4,N/**/T5,N/**/T6);
#define PROTOCCALLSFSUB7(NAME,T1,T2,T3,T4,T5,T6,T7)                            \
                    void NAME(N/**/T1,N/**/T2,N/**/T3,N/**/T4,N/**/T5,N/**/T6, \
                              N/**/T7);
#define PROTOCCALLSFSUB8(NAME,T1,T2,T3,T4,T5,T6,T7,T8)                         \
                    void NAME(N/**/T1,N/**/T2,N/**/T3,N/**/T4,N/**/T5,N/**/T6, \
                              N/**/T7,N/**/T8);
#define PROTOCCALLSFSUB9(NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9)                      \
                    void NAME(N/**/T1,N/**/T2,N/**/T3,N/**/T4,N/**/T5,N/**/T6, \
                              N/**/T7,N/**/T8,N/**/T9);
#define PROTOCCALLSFSUB10(NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA)                  \
                    void NAME(N/**/T1,N/**/T2,N/**/T3,N/**/T4,N/**/T5,N/**/T6, \
                              N/**/T7,N/**/T8,N/**/T9,N/**/TA);
#define PROTOCCALLSFSUB11(NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB)               \
                    void NAME(N/**/T1,N/**/T2,N/**/T3,N/**/T4,N/**/T5,N/**/T6, \
                              N/**/T7,N/**/T8,N/**/T9,N/**/TA,N/**/TB);
#define PROTOCCALLSFSUB16(NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG)\
                    void NAME(N/**/T1,N/**/T2,N/**/T3,N/**/T4,N/**/T5,N/**/T6, \
                              N/**/T7,N/**/T8,N/**/T9,N/**/TA,N/**/TB,N/**/TC, \
                              N/**/TD,N/**/TE,N/**/TF,N/**/TG);


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

/*               UTILITIES FOR C TO CALL FORTRAN FUNCTIONS                 */

/* WARNING: (P)STRINGV does not work, when calling FORTRAN FUNCTIONS. */

/*N.B. PROTOCCALLSFFUNn(..) generates code, whether or not the FORTRAN
  function is called. Therefore, especially for creator's of C header files
  for large FORTRAN libraries which include many functions, to reduce
  compile time and object code size, it may be desirable to create
  preprocessor directives to allow users to create code for only those
  functions which they use.                                                */

/* The following defines the maximum length string that a function can return.
   Of course it may be undefine-d and re-define-d before individual
   PROTOCCALLSFFUNn(..) as required.                                       */
#define MAX_LEN_FORTRAN_FUNCTION_STRING 0x4FE

/* The following defines a character used by CFORTRAN to flag the end of a
   string coming out of a FORTRAN routine.                                 */
#define CFORTRAN_NON_CHAR 0x7F

/* Define lookup tables for how to handle the various types of variables.
   Tables used by for value  returnde by - function:  U,E,G,X
                                         - arguments: U,B,D,W
   Note that W... tables are from above.                                   */
#define UDOUBLE        double
#define UFLOAT         float
#define UINT           int
#define ULOGICAL       int
#define ULONG          long
#define USTRING        char   *
#define UFLOATV        float  *
#define UINTV          int    *
#define USTRINGV       char   *
#define UFLOATVV       float  *
#define UINTVV         int    *
#define UPDOUBLE       double *
#define UPFLOAT        float  *
#define UPINT          int    *
#define UPLOGICAL      int    *
#define UPLONG         long   *
#define UPSTRING       char   *
#define UPSTRINGV      char   *
#define UPVOID         void   *
#define UPSTRUCT       void   *
#define UVOID          void   * /*Needed for FORTRAN calls to C subroutines. */

#define EDOUBLE        double A0;
#define EFLOAT         float  A0;
#define EINT           int    A0;
#define ELOGICAL       int    A0;
#define ELONG          long   A0;
#define ESTRING        static char AA0[MAX_LEN_FORTRAN_FUNCTION_STRING+1];     \
                       static fstring A0 =                                     \
             {MAX_LEN_FORTRAN_FUNCTION_STRING,DSC$K_DTYPE_T,DSC$K_CLASS_S,AA0};\
               memset(AA0, CFORTRAN_NON_CHAR, MAX_LEN_FORTRAN_FUNCTION_STRING);\
                                    *(AA0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0';
/* ESTRING must use static char. array which is guaranteed to exist after
   function returns.                                                     */

/* N.B.i) The diff. for 0 (Zero) and >=1 arguments.
       ii)That the folowing create a single unmatched '(' bracket, which
          must of course be matched in the call.
       iii)Commas must be handled very carefully                         */
#define GZDOUBLE(   B) A0=B(
#define GZFLOAT(    B) A0=B(
#define GZINT(      B) A0=B(
#define GZLOGICAL(  B) A0=B(
#define GZLONG(     B) A0=B(
#define GZSTRING(   B) B(&A0

#define GDOUBLE(    B) A0=B(
#define GFLOAT(     B) A0=B(
#define GINT(       B) A0=B(
#define GLOGICAL(   B) A0=B(
#define GLONG(      B) A0=B(
#define GSTRING(    B) B(&A0,

#define BDOUBLE(    A) (double)   A
#define BFLOAT(     A) (float)    A
#define BINT(       A) (int)      A    /* typecast for enum's sake */
#define BLOGICAL(   A) (int)      A
#define BLONG(      A) (long)     A
#define BSTRING(    A) (char *)   A
#define BFLOATV(    A)            A
#define BINTV(      A)            A
#define BSTRINGV(   A) (char *)   A
#define BFLOATVV(   A)           (A)[0]
#define BINTVV(     A)           (A)[0]
#define BPDOUBLE(   A)           & A
#define BPFLOAT(    A)           & A
#define BPINT(      A)           & A /*no longer typecast for enum*/
#define BPLOGICAL(  A)           & A
#define BPLONG(     A)           & A
#define BPSTRING(   A) (char *)   A
#define BPSTRINGV(  A) (char *)   A
#define BPVOID(     A) (void *)   A
#define BPSTRUCT(   A) (void *)  &A
                                                              	
/* In the S.. and H.. tables, all entries other than (P)STRING(V) are dummy.  */
#define SDOUBLE(    A) ,(A,1)
#define SFLOAT(     A) ,(A,1)
#define SINT(       A) ,(A,1)
#define SLOGICAL(   A) ,(A,1)
#define SLONG(      A) ,(A,1)
#define SSTRING(    A) ,sizeof(A)
#define SFLOATV(    A) ,(A,1)
#define SINTV(      A) ,(A,1)
#define SSTRINGV(   A) ,( (unsigned)0xFFFF*firstindexlength(A)                 \
                         +secondindexlength(A))
#define SFLOATVV(   A) ,(A,1)
#define SINTVV(     A) ,(A,1)
#define SPDOUBLE(   A) ,(A,1)
#define SPFLOAT(    A) ,(A,1)
#define SPINT(      A) ,(A,1)
#define SPLOGICAL(  A) ,(A,1)
#define SPLONG(     A) ,(A,1)
#define SPSTRING(   A) ,sizeof(A)
#define SPSTRINGV      SSTRINGV
#define SPVOID(     A) ,(A,1)
#define SPSTRUCT(   A) ,(A,1)

#define HDOUBLE(    A) ,int A
#define HFLOAT(     A) ,int A
#define HINT(       A) ,int A
#define HLOGICAL(   A) ,int A
#define HLONG(      A) ,int A
#define HSTRING(    A) ,unsigned A
#define HFLOATV(    A) ,int A
#define HINTV(      A) ,int A
#define HSTRINGV(   A) ,unsigned A
#define HFLOATVV(   A) ,int A
#define HINTVV(     A) ,int A
#define HPDOUBLE(   A) ,int A
#define HPFLOAT(    A) ,int A
#define HPINT(      A) ,int A
#define HPLOGICAL(  A) ,int A
#define HPLONG(     A) ,int A
#define HPSTRING(   A) ,unsigned A
#define HPSTRINGV(  A) ,unsigned A
#define HPVOID(     A) ,int A
#define HPSTRUCT(   A) ,int A

#define CCF(TN,I)        C/**/TN(A/**/I,B/**/I,C/**/I)
#define CDOUBLE(  A,B,C) (B,C,&A)
#define CFLOAT(   A,B,C) (B,C,&A)
#define CINT(     A,B,C) (B,C,&A)
#define CLOGICAL( A,B,C) (B,C,&A)
#define CLONG(    A,B,C) (B,C,&A)
#define CSTRING(  A,B,C) (B.clen=strlen(A),B.f.dsc$a_pointer=A,                \
                    C==sizeof(char*)||C==B.clen+1?B.f.dsc$w_length=B.clen,&B.f:\
          (memset((A)+B.clen,' ',C-B.clen-1),A[B.f.dsc$w_length=C-1]='\0',&B.f))
#define CFLOATV(  A,B,C) (B,C,A)
#define CINTV(    A,B,C) (B,C,A)
#define CSTRINGV( A,B,C) (                                                     \
          initfstr(B, malloc((C/0xFFFF)*(C%0xFFFF-1)), C/0xFFFF, C%0xFFFF-1),  \
          c2fstrv(A,B.dsc$a_pointer,C%0xFFFF,(C/0xFFFF)*(C%0xFFFF))         ,&B)
#define CFLOATVV( A,B,C) (B,C,A)
#define CINTVV(   A,B,C) (B,C,A)
#define CPDOUBLE( A,B,C) (B,C,A)
#define CPFLOAT(  A,B,C) (B,C,A)
#define CPINT(    A,B,C) (B,C,A)
#define CPLOGICAL(A,B,C) (B,C,A)
#define CPLONG(   A,B,C) (B,C,A)
#define CPSTRING( A,B,C) (B.dsc$w_length=strlen(A),B.dsc$a_pointer=A,          \
        C==sizeof(char*)?&B:(memset((A)+B.dsc$w_length,' ',C-B.dsc$w_length-1),\
                             A[B.dsc$w_length=C-1]='\0',&B))
#define CPSTRINGV(A,B,C)  (initfstr(B, A, C/0xFFFF, C%0xFFFF-1),               \
                           c2fstrv(A,A,C%0xFFFF,(C/0xFFFF)*(C%0xFFFF)) ,&B)
#define CPVOID(   A,B,C) (B,C,A)
#define CPSTRUCT( A,B,C) (B,C,A)

#define XDOUBLE        return A0;
#define XFLOAT         return A0;
#define XINT           return A0;
#define XLOGICAL       return A0;
#define XLONG          return A0;
#define XSTRING        return kill_trailing(                                   \
                                      kill_trailing(AA0,CFORTRAN_NON_CHAR),' ');

#define CFFUN(NAME) __cf__/**/NAME

#define CCALLSFFUN0(NAME) CFFUN(NAME)()

#define CCALLSFFUN1(NAME,T1,A1) CFFUN(NAME)(B/**/T1(A1) S/**/T1(A1))

#define CCALLSFFUN2(NAME,T1,T2,A1,A2) CFFUN(NAME)(B/**/T1(A1),B/**/T2(A2)      \
                                                  S/**/T1(A1) S/**/T2(A2))

#define CCALLSFFUN3(NAME,T1,T2,T3,A1,A2,A3)                                    \
CFFUN(NAME)(B/**/T1(A1),B/**/T2(A2),B/**/T3(A3)                                \
            S/**/T1(A1) S/**/T2(A2) S/**/T3(A3))

#define CCALLSFFUN4(NAME,T1,T2,T3,T4,A1,A2,A3,A4)                              \
CFFUN(NAME)(B/**/T1(A1),B/**/T2(A2),B/**/T3(A3),B/**/T4(A4)                    \
            S/**/T1(A1) S/**/T2(A2) S/**/T3(A3) S/**/T4(A4))

#define CCALLSFFUN5(NAME,T1,T2,T3,T4,T5,A1,A2,A3,A4,A5)                        \
CFFUN(NAME)(B/**/T1(A1),B/**/T2(A2),B/**/T3(A3),B/**/T4(A4),B/**/T5(A5)        \
            S/**/T1(A1) S/**/T2(A2) S/**/T3(A3) S/**/T4(A4) S/**/T5(A5))

#define CCALLSFFUN6(NAME,T1,T2,T3,T4,T5,T6,A1,A2,A3,A4,A5,A6)                  \
CFFUN(NAME)(B/**/T1(A1),B/**/T2(A2),B/**/T3(A3),B/**/T4(A4),B/**/T5(A5)        \
            B/**/T6(A6)                                                        \
S/**/T1(A1) S/**/T2(A2) S/**/T3(A3) S/**/T4(A4) S/**/T5(A5) S/**/T6(A6))

#define CCALLSFFUN7(NAME,T1,T2,T3,T4,T5,T6,T7,A1,A2,A3,A4,A5,A6,A7)            \
CFFUN(NAME)(B/**/T1(A1),B/**/T2(A2),B/**/T3(A3),B/**/T4(A4),B/**/T5(A5)        \
            B/**/T6(A6),B/**/T7(A7) S/**/T1(A1) S/**/T2(A2) S/**/T3(A3)        \
            S/**/T4(A4) S/**/T5(A5) S/**/T6(A6) S/**/T7(A7))

/*  N.B. Create a separate function instead of using (call function, function
value here) because in order to create the variables needed for the input
arg.'s which may be const.'s one has to do the creation within {}, but these
can never be placed within ()'s. Therefore one must create wrapper functions.
gcc, on the other hand may be able to avoid the wrapper functions. */

#define PROTOCCALLSFFUN0(F,NAME)                                               \
U/**/F NAME(); /* This is needed to correctly handle the value returned        \
N.B. Can only have prototype arg.'s with difficulty, a la G... table since     \
FORTRAN functions returning strings have extra arg.'s. Don't bother, since     \
this only causes a compiler warning to come up when one uses FCALLSCFUNn and   \
CCALLSFFUNn for the same function in the same source code. Something done by   \
the experts in tests only.*/                                                   \
static U/**/F CFFUN(NAME)()                                                    \
{E/**/F GZ/**/F(NAME)); X/**/F}

#define PROTOCCALLSFFUN1(F,NAME,T1)                                            \
U/**/F NAME();                                                                 \
static U/**/F CFFUN(NAME)(U/**/T1 A1 H/**/T1(C1))                              \
{VCF(T1,1) E/**/F G/**/F(NAME)CCF(T1,1)); WCF(T1,1) X/**/F}

#define PROTOCCALLSFFUN2(F,NAME,T1,T2)                                         \
U/**/F NAME();                                                                 \
static U/**/F CFFUN(NAME)(U/**/T1 A1,U/**/T2 A2 H/**/T1(C1) H/**/T2(C2))       \
{VCF(T1,1) VCF(T2,2) E/**/F G/**/F(NAME)CCF(T1,1),CCF(T2,2));                  \
 WCF(T1,1) WCF(T2,2) X/**/F}

#define PROTOCCALLSFFUN3(F,NAME,T1,T2,T3)                                      \
U/**/F NAME();                                                                 \
static U/**/F CFFUN(NAME)(U/**/T1 A1,U/**/T2 A2,U/**/T3 A3                     \
                          H/**/T1(C1) H/**/T2(C2) H/**/T3(C3))                 \
{VCF(T1,1) VCF(T2,2) VCF(T3,3) E/**/F                                          \
 G/**/F(NAME)CCF(T1,1),CCF(T2,2),CCF(T3,3)); WCF(T1,1)WCF(T2,2)WCF(T3,3)X/**/F}

#define PROTOCCALLSFFUN4(F,NAME,T1,T2,T3,T4)                                   \
U/**/F NAME();                                                                 \
static U/**/F CFFUN(NAME)(U/**/T1 A1,U/**/T2 A2,U/**/T3 A3,U/**/T4 A4          \
                          H/**/T1(C1) H/**/T2(C2) H/**/T3(C3) H/**/T4(C4))     \
{VCF(T1,1) VCF(T2,2) VCF(T3,3) VCF(T4,4) E/**/F                                \
 G/**/F(NAME)CCF(T1,1),CCF(T2,2),CCF(T3,3),CCF(T4,4));                         \
 WCF(T1,1) WCF(T2,2) WCF(T3,3) WCF(T4,4) X/**/F}

#define PROTOCCALLSFFUN5(F,NAME,T1,T2,T3,T4,T5)                                \
U/**/F NAME();                                                                 \
static U/**/F CFFUN(NAME)(U/**/T1 A1,U/**/T2 A2,U/**/T3 A3,U/**/T4 A4,         \
   U/**/T5 A5 H/**/T1(C1) H/**/T2(C2) H/**/T3(C3) H/**/T4(C4) H/**/T5(C5))     \
{VCF(T1,1) VCF(T2,2) VCF(T3,3) VCF(T4,4) VCF(T5,5) E/**/F                      \
 G/**/F(NAME)CCF(T1,1),CCF(T2,2),CCF(T3,3),CCF(T4,4),CCF(T5,5));               \
 WCF(T1,1) WCF(T2,2) WCF(T3,3) WCF(T4,4) WCF(T5,5) X/**/F}

#define PROTOCCALLSFFUN6(F,NAME,T1,T2,T3,T4,T5,T6)                             \
U/**/F NAME();                                                                 \
static U/**/F CFFUN(NAME)(U/**/T1 A1,U/**/T2 A2,U/**/T3 A3,U/**/T4 A4,         \
                          U/**/T5 A5,U/**/T6 A6 H/**/T1(C1) H/**/T2(C2)        \
                        H/**/T3(C3) H/**/T4(C4) H/**/T5(C5) H/**/T6(C6))       \
{VCF(T1,1) VCF(T2,2) VCF(T3,3) VCF(T4,4) VCF(T5,5) VCF(T6,6) E/**/F            \
 G/**/F(NAME)CCF(T1,1),CCF(T2,2),CCF(T3,3),CCF(T4,4),CCF(T5,5),CCF(T6,6));     \
 WCF(T1,1) WCF(T2,2) WCF(T3,3) WCF(T4,4) WCF(T5,5) WCF(T6,6) X/**/F}
                                                      
#define PROTOCCALLSFFUN7(F,NAME,T1,T2,T3,T4,T5,T6,T7)                          \
U/**/F NAME();                                                                 \
static U/**/F CFFUN(NAME)(U/**/T1 A1,U/**/T2 A2,U/**/T3 A3,U/**/T4 A4,         \
                          U/**/T5 A5,U/**/T6 A6,U/**/T7 A7 H/**/T1(C1)         \
  H/**/T2(C2) H/**/T3(C3) H/**/T4(C4) H/**/T5(C5) H/**/T6(C6) H/**/T7(C7))     \
{VCF(T1,1) VCF(T2,2) VCF(T3,3) VCF(T4,4) VCF(T5,5) VCF(T6,6) VCF(T7,7) E/**/F  \
 G/**/F(NAME)CCF(T1,1),CCF(T2,2),CCF(T3,3),CCF(T4,4),                          \
                CCF(T5,5),CCF(T6,6),CCF(T7,7));                                \
 WCF(T1,1) WCF(T2,2) WCF(T3,3) WCF(T4,4) WCF(T5,5) WCF(T6,6) WCF(T7,7) X/**/F}


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

/*               UTILITIES FOR FORTRAN TO CALL C ROUTINES                  */

/* Note that the following two macros are dummies. */
/* Applications have to #undef and re- #define at least one of them.
   Otherwise the name of the interpretation routine for FORTRAN code will
   have the same name as the original C routine.
   e.g. If one wishes to prepend a 'c' to C function names when they are
        called by FORTRAN:
   #undef  fcallsc
   #define fcallsc(NAME) C##NAME
*/
#define fcallsc(NAME) NAME
#define ccallsc(NAME) NAME

/* Define lookup tables for how to handle the various types of variables.  */
/* N.B. Except for (P)STRING(V) the first of the following two expressions is a
   dummy so that the VMS compiler does not complain that both arguments aren't
   used. */
#define TDOUBLE(  A,B) (B,*A)
#define TFLOAT(   A,B) (B,*A)
#define TINT(     A,B) (B,*A)
#define TLOGICAL( A,B) (B,*A)
#define TLONG(    A,B) (B,*A)
#define TSTRING(  A,B) ((B=malloc(A->dsc$w_length+1))[A->dsc$w_length]='\0',   \
 kill_trailing(memcpy(B,A->dsc$a_pointer,A->dsc$w_length),' '))
#define TDOUBLEV( A,B) (B,A)
#define TFLOATV(  A,B) (B,A)
#define TINTV(    A,B) (B,A)
#define TLOGICALV(A,B) (B,A)
#define TLONGV(   A,B) (B,A)
#define TSTRINGV( A,B)                                                         \
 (B=malloc((A->dsc$w_length+1)*A->dsc$l_m[0]), (void *)f2cstrvcopy(B,A))
#define TPDOUBLE( A,B) (B, (double *)A)
#define TPFLOAT(  A,B) (B,  (float *)A)
#define TPINT(    A,B) (B,    (int *)A)
#define TPLOGICAL(A,B) (B,    (int *)A)
#define TPLONG(   A,B) (B,   (long *)A)
#define TPSTRING       TSTRING
#define TPSTRINGV      TSTRINGV
#define TPVOID(   A,B) (B,   (void *)A)

#define FDOUBLE        double        *
#define FFLOAT         float         *
#define FINT           int           *
#define FLOGICAL       int           *
#define FLONG          long          *
#define FSTRING        fstring       *
#define FDOUBLEV       double        *
#define FFLOATV        float         *
#define FINTV          int           *
#define FLOGICALV      int           *
#define FLONGV         long          *
#define FSTRINGV       fstringvector *
#define FPDOUBLE       double        *
#define FPFLOAT        float         *
#define FPINT          int           *
#define FPLOGICAL      int           *
#define FPLONG         long          *
#define FPSTRING       fstring       *
#define FPSTRINGV      fstringvector *
#define FPVOID         void          *

/* N.B. Except for PSTRING(V) the first of the following two expressions is a
   dummy so that the VMS compiler does not complain that both arguments aren't
   used. */
#define RDOUBLE(  A,B) B,A
#define RFLOAT(   A,B) B,A
#define RINT(     A,B) B,A
#define RLOGICAL( A,B) B,A
#define RLONG(    A,B) B,A
#define RSTRING(  A,B) A,free(B)
#define RDOUBLEV( A,B) B,A
#define RFLOATV(  A,B) B,A
#define RINTV(    A,B) B,A
#define RLOGICALV(A,B) B,A
#define RLONGV(   A,B) B,A
#define RSTRINGV( A,B) A,free(B)
#define RPDOUBLE( A,B) B,A
#define RPFLOAT(  A,B) B,A
#define RPINT(    A,B) B,A
#define RPLOGICAL(A,B) B,A
#define RPLONG(   A,B) B,A
#define RPSTRING(A,B) memcpy(A->dsc$a_pointer,B,MIN(strlen(B),A->dsc$w_length))\
 ,(A->dsc$w_length>strlen(B)?                                                  \
   memset(A->dsc$a_pointer+strlen(B),' ', A->dsc$w_length-strlen(B)):0),free(B)
#define RPSTRINGV(A,B) c2fstrvcopy(B,A,A->dsc$w_length+1), free(B)
#define RPVOID(   A,B) B,A

#define MZDOUBLE(   A) double  fcallsc(A)(
#define MZFLOAT(    A) float   fcallsc(A)(
#define MZINT(      A) int     fcallsc(A)(
#define MZLOGICAL(  A) int     fcallsc(A)(
#define MZLONG(     A) long    fcallsc(A)(
#define MZSTRING(   A) void    fcallsc(A)(fstring *AS
#define MZVOID(     A) void    fcallsc(A)(

#define MDOUBLE(    A) double  fcallsc(A)(
#define MFLOAT(     A) float   fcallsc(A)(
#define MINT(       A) int     fcallsc(A)(
#define MLOGICAL(   A) int     fcallsc(A)(
#define MLONG(      A) long    fcallsc(A)(
#define MSTRING(    A) void    fcallsc(A)(fstring *AS,
#define MVOID(      A) void    fcallsc(A)(

#define LDOUBLE(NAME)  A0=ccallsc(NAME)
#define LFLOAT(NAME)   A0=ccallsc(NAME)
#define LINT(NAME)     A0=ccallsc(NAME)
#define LLOGICAL(NAME) A0=ccallsc(NAME)
#define LLONG(NAME)    A0=ccallsc(NAME)
#define LSTRING(NAME)  A0=ccallsc(NAME)
#define LVOID(NAME)       ccallsc(NAME)

/* Note that D.. and D.. can't be combined since D.. has to access data before
R.., in order for functions returning strings which are also passed in as
arguments to work correctly. Note that R.. frees and hence may corrupt the
string. */
#define IDOUBLE        return  A0;
#define IFLOAT         return  A0;
#define IINT           return  A0;
#define ILOGICAL       return  A0;
#define ILONG          return  A0;
#define ISTRING        return    ;
#define IVOID          return    ;

#define DDOUBLE
#define DFLOAT
#define DINT
#define DLOGICAL
#define DLONG
#define DSTRING                                                                \
 memcpy(AS->dsc$a_pointer,A0, MIN(AS->dsc$w_length,(A0==NULL?0:strlen(A0))) ); \
 AS->dsc$w_length>(A0==NULL?0:strlen(A0))?                                     \
  memset(AS->dsc$a_pointer+(A0==NULL?0:strlen(A0)),' ',                        \
         AS->dsc$w_length-(A0==NULL?0:strlen(A0))):0;
/* The above line has to copy the string into the position provided by the
   caller. */
#define DVOID

#define FCALLSCSUB0(NAME)                FCALLSCFUN0(VOID,NAME)
#define FCALLSCSUB1(NAME,T1)             FCALLSCFUN1(VOID,NAME,T1)
#define FCALLSCSUB2(NAME,T1,T2)          FCALLSCFUN2(VOID,NAME,T1,T2)
#define FCALLSCSUB3(NAME,T1,T2,T3)       FCALLSCFUN3(VOID,NAME,T1,T2,T3)
#define FCALLSCSUB4(NAME,T1,T2,T3,T4)    FCALLSCFUN4(VOID,NAME,T1,T2,T3,T4)
#define FCALLSCSUB5(NAME,T1,T2,T3,T4,T5) FCALLSCFUN5(VOID,NAME,T1,T2,T3,T4,T5)
#define FCALLSCSUB6(NAME,T1,T2,T3,T4,T5,T6)                                    \
                               FCALLSCFUN6(VOID,NAME,T1,T2,T3,T4,T5,T6)       
#define FCALLSCSUB7(NAME,T1,T2,T3,T4,T5,T6,T7)                                 \
                               FCALLSCFUN7(VOID,NAME,T1,T2,T3,T4,T5,T6,T7)
#define FCALLSCSUB8(NAME,T1,T2,T3,T4,T5,T6,T7,T8)                              \
                               FCALLSCFUN8(VOID,NAME,T1,T2,T3,T4,T5,T6,T7,T8)
#define FCALLSCSUB9(NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9)                           \
                               FCALLSCFUN9(VOID,NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9)

#define FCALLSCFUN0(T0, NAME)                                                  \
MZ/**/T0(NAME)) {U/**/T0 A0; L/**/T0(NAME)(); D/**/T0 I/**/T0}

#define FCALLSCFUN1(T0, NAME, T1)                                              \
M/**/T0(NAME)F/**/T1 A1) {U/**/T0 A0; U/**/T1 B1;                              \
 L/**/T0(NAME)(T/**/T1(A1,B1)); D/**/T0 R/**/T1(A1,B1); I/**/T0}

#define FCALLSCFUN2(T0, NAME, T1, T2)                                          \
M/**/T0(NAME)F/**/T1 A1, F/**/T2 A2) {U/**/T0 A0; U/**/T1 B1; U/**/T2 B2;      \
 L/**/T0(NAME)(T/**/T1(A1,B1), T/**/T2(A2,B2));                                \
 D/**/T0 R/**/T1(A1,B1); R/**/T2(A2,B2); I/**/T0}

#define FCALLSCFUN3(T0, NAME, T1, T2, T3)                                      \
M/**/T0(NAME)F/**/T1 A1, F/**/T2 A2, F/**/T3 A3)                               \
{U/**/T0 A0; U/**/T1 B1; U/**/T2 B2; U/**/T3 B3;                               \
 L/**/T0(NAME)(T/**/T1(A1,B1), T/**/T2(A2,B2), T/**/T3(A3,B3));                \
 D/**/T0 R/**/T1(A1,B1); R/**/T2(A2,B2); R/**/T3(A3,B3); I/**/T0}

#define FCALLSCFUN4(T0, NAME, T1, T2, T3, T4)                                  \
M/**/T0(NAME)F/**/T1 A1, F/**/T2 A2, F/**/T3 A3, F/**/T4 A4)                   \
{U/**/T0 A0; U/**/T1 B1; U/**/T2 B2; U/**/T3 B3; U/**/T4 B4;                   \
 L/**/T0(NAME)(T/**/T1(A1,B1), T/**/T2(A2,B2), T/**/T3(A3,B3), T/**/T4(A4,B4));\
 D/**/T0 R/**/T1(A1,B1);R/**/T2(A2,B2); R/**/T3(A3,B3); R/**/T4(A4,B4); I/**/T0}

#define FCALLSCFUN5(T0, NAME, T1, T2, T3, T4, T5)                              \
M/**/T0(NAME)F/**/T1 A1, F/**/T2 A2, F/**/T3 A3, F/**/T4 A4, F/**/T5 A5)       \
{U/**/T0 A0; U/**/T1 B1; U/**/T2 B2; U/**/T3 B3; U/**/T4 B4; U/**/T5 B5;       \
 L/**/T0(NAME)(T/**/T1(A1,B1), T/**/T2(A2,B2), T/**/T3(A3,B3), T/**/T4(A4,B4), \
               T/**/T5(A5,B5)); D/**/T0 R/**/T1(A1,B1); R/**/T2(A2,B2);        \
 R/**/T3(A3,B3); R/**/T4(A4,B4); R/**/T5(A5,B5); I/**/T0}

#define FCALLSCFUN6(T0, NAME, T1, T2, T3, T4, T5, T6)                          \
M/**/T0(NAME)F/**/T1 A1,F/**/T2 A2,F/**/T3 A3,F/**/T4 A4,F/**/T5 A5,F/**/T6 A6)\
{U/**/T0 A0; U/**/T1 B1;U/**/T2 B2;U/**/T3 B3;U/**/T4 B4;U/**/T5 B5;U/**/T6 B6;\
 L/**/T0(NAME)(T/**/T1(A1,B1), T/**/T2(A2,B2), T/**/T3(A3,B3), T/**/T4(A4,B4), \
 T/**/T5(A5,B5), T/**/T6(A6,B6)); D/**/T0 R/**/T1(A1,B1); R/**/T2(A2,B2);      \
 R/**/T3(A3,B3); R/**/T4(A4,B4); R/**/T5(A5,B5); R/**/T6(A6,B6); I/**/T0}

#define FCALLSCFUN7(T0, NAME, T1, T2, T3, T4, T5, T6, T7)                      \
M/**/T0(NAME)F/**/T1 A1, F/**/T2 A2, F/**/T3 A3, F/**/T4 A4,                   \
             F/**/T5 A5, F/**/T6 A6, F/**/T7 A7)                               \
{U/**/T0 A0; U/**/T1 B1; U/**/T2 B2; U/**/T3 B3; U/**/T4 B4; U/**/T5 B5;       \
 U/**/T6 B6; U/**/T7 B7;                                                       \
 L/**/T0(NAME)(  T/**/T1(A1,B1), T/**/T2(A2,B2), T/**/T3(A3,B3),               \
 T/**/T4(A4,B4), T/**/T5(A5,B5), T/**/T6(A6,B6), T/**/T7(A7,B7));              \
 D/**/T0 R/**/T1(A1,B1); R/**/T2(A2,B2); R/**/T3(A3,B3); R/**/T4(A4,B4);       \
         R/**/T5(A5,B5); R/**/T6(A6,B6); R/**/T7(A7,B7); I/**/T0}


#endif					/* __CFORTRAN_LOADED */
#endif                                  /* This is VMS.      */
--------------cut for cfortest.c----------------------------------
/* cfortest.c */
/* Burkhard Burow, burow%13313.hepnet@csa3.lbl.gov, U. of Toronto, 1991. */

#include <stdio.h>
#include "cfortran.h"

#define FJ_SELECT 1   /* To see the various examples select one of: 
        EASY_SELECT, ST_SELECT, FT_SELECT S1_SELECT ABC_SELECT R_SELECT,
        REV_SELECT, F0_SELECT, FA_SELECT, FB_SELECT, FC_SELECT, FD_SELECT, 
        FE_SELECT, FF_SELECT, FG_SELECT, FH_SELECT, FI_SELECT, FJ_SELECT. */

#if defined(vms) || defined(rs6000)
#undef ccallsc
#define ccallsc(NAME) NAME/**/CF
/* Under VMS and on the rs6000, this differentiates the original C routine name 
   from that of the FORTRAN entry point, i.e. that of the cfortran generated 
   wrapper. It isn't needed under MIPS Risc because the f77 appends the 
   underscore character, '_', to all external references. See cfortran.doc for 
   more details.*/
#endif

#ifdef N1_SELECT
PROTOCCALLSFFUN1(INT,n1,PSTRINGV)
#define N1(A1)              CCALLSFFUN1(n1,PSTRINGV,A1)

main() {
static char b[][16] = {"01234","56789"};
N1(b); /*printf("n1(b) returns %d; ", N1(b)); */
printf("with b[0] = %s;\n", b[0]);
printf("and  b[1] = %s;\n", b[1]);
}
#endif

#ifndef jkhjhk

#ifdef EASY_SELECT
PROTOCCALLSFSUB2(easy,PINT,INT)
#define EASY(A,B)      CCALLSFSUB2(easy,PINT,INT, A,B)

main() {
int a;
printf("\nEASY EXAMPLE\n");
EASY(a,7);
printf("The FORTRAN routine easy(a,7) returns a = %d\n", a);
}
#endif

#ifdef ST_SELECT
PROTOCCALLSFSUB3(st,PSTRINGV,STRINGV,FLOAT)
#define ST(A,B,C) CCALLSFSUB3(st,PSTRINGV,STRINGV,FLOAT,A,B,C)

int main() {
static char v[][5] = {"0000", "1", "22", ""};
static char w[][9]  = {"", "bb","ccc","dddd"};
ST(v, w, 10.);
printf("main:v=%s,%s,%s,%s. PSTRINGV => Has had trailing blanks stripped.\n",
       v[0],v[1],v[2],v[3]);
printf("main:w=%s,%s,%s,%s. STRINGV => malloc'd copy for FORTRAN=> C intact.\n"
       ,w[0],w[1],w[2],w[3]);
}
#endif

#ifdef FT_SELECT
PROTOCCALLSFFUN3(STRING,ft,PSTRINGV,STRINGV,FLOAT)
#define FT(A,B,C) CCALLSFFUN3(ft,PSTRINGV,STRINGV,FLOAT,A,B,C)

main() {
static char v[][5] = {"0000", "1", "22", ""};
static char w[][9]  = {"", "bb","ccc","dddd"};
float a = 10.0;
printf("FT(v, w, a); returns:%s.\n",FT(v, w, a));
printf("main:v=%s,%s,%s,%s. PSTRINGV => Has had trailing blanks stripped.\n",
       v[0],v[1],v[2],v[3]);
printf("main:w=%s,%s,%s,%s. STRINGV => malloc'd copy for FORTRAN=> C intact.\n"
       ,w[0],w[1],w[2],w[3]);
}
#endif

#ifdef S1_SELECT
PROTOCCALLSFSUB1(s1,PSTRING)
#define S1(A1)              CCALLSFSUB1(s1,PSTRING,A1)
PROTOCCALLSFSUB1(forstr1,PSTRING)
#define FORSTR1(A1)         CCALLSFSUB1(forstr1,PSTRING,A1)

main() {
static char b[] = "abcdefghij", forb[13] = "abcdefghijkl";
S1(b); FORSTR1(forb);
printf("s1(b) returns b = %s; forstr1(forb) = returns forb = %s;\n", b, forb);
}
#endif

#ifdef ABC_SELECT
PROTOCCALLSFSUB3(abc,STRING,PSTRING,PSTRING)
#define ABC(A1,A2,A3)       CCALLSFSUB3(abc,STRING,PSTRING,PSTRING,A1,A2,A3)

main() {
static char aa[] = "one  ", bb[] = "two  ", cc[] = "three"; int i; 
for (i=0; i<10; i++) {printf("%s;%s;%s;\n",aa,bb,cc); ABC(aa,bb,cc);}
}
#endif

#ifdef R_SELECT
PROTOCCALLSFFUN1(FLOAT,r,INT)
#define R(A1)               CCALLSFFUN1(r,INT,A1)
PROTOCCALLSFFUN0(STRING,forstr2)
#define FORSTR2()           CCALLSFFUN0(forstr2)
PROTOCCALLSFFUN1(STRING,forstr,STRING)
#define FORSTR(A1)          CCALLSFFUN1(forstr,STRING,A1)

main() {
static char aa[] = "one";
int rrr = 333;
printf("R(rrr=%d) returns int arg. as float:%f\n",rrr,R(rrr));
printf("FORSTR(aa=%s) returns the string arg. as:%s<-end here\n",aa,FORSTR(aa));
printf("FORSTR2() returns the string constant:%s<-end here\n",FORSTR2());
}
#endif

#ifdef REV_SELECT
PROTOCCALLSFFUN1(INT,frev,INTV)
#define FREV(A1)               CCALLSFFUN1(frev,INTV,A1)
PROTOCCALLSFSUB1(rev,INTV)
#define REV(A1)                CCALLSFSUB1(rev,INTV,A1)

main() {
static int a[] = {1,2};
printf("REV(a[0,1]=%d,%d) returns:",a[0],a[1]);
REV(a); printf("a[0,1]=%d,%d\n",a[0],a[1]);
printf("FREV(a[0,1]=%d,%d) returns:",a[0],a[1]);
printf("%d",FREV(a)); printf(" with a[0,1]=%d,%d\n",a[0],a[1]);
}
#endif


/* The following functions are called by FORTRAN functions, as shown by the 
   remaining examples. */
#define EXIST ccallsc(exist)
void EXIST() {printf("EXIST: was called.\n");}
FCALLSCSUB0(exist)

#define CA ccallsc(ca)
void CA(int i) {printf("CA: had integer argument:%d.\n",i);}
FCALLSCSUB1(ca,INT)

#define CB ccallsc(cb)
void CB(int *i) {
printf("CB: had pointer argument to integer:%d.\n",*i); *i*=2;}
FCALLSCSUB1(cb,PINT)

#define CC ccallsc(cc)
void CC(char *s) {printf("CC: had string argument:%s.\n",s);}
FCALLSCSUB1(cc,STRING)

#define CD ccallsc(cd)
void CD(char *s) 
{printf("CD: had string argument:%s.\n",s); strcpy(s,"to you 12345678");}
FCALLSCSUB1(cd,PSTRING)

#define CE ccallsc(ce)
void CE(char v[][5]) 
{printf("CE: had string vector argument:%s,%s,%s.\n",v[0],v[1],v[2]);}
#define ce_STRV_A1 TERM_CHARS(' ',1)
FCALLSCSUB1(ce,STRINGV)

#define CF ccallsc(cf)
void CF(char v[][5], int n) 
{int i;
printf("CF: had %d string vector argument:",n);
for (i=0; i<n-1; i++) printf("%s,",v[i]);
printf("%s.\n",v[i]);
}
#define cf_STRV_A1 NUM_ELEM_ARG(2)
FCALLSCSUB2(cf,STRINGV,INT)


#define CG ccallsc(cg)
int CG() {return 1;}
FCALLSCFUN0(INT,cg)

#define CH ccallsc(ch)
char *CH() {return "hello";}
FCALLSCFUN0(STRING,ch)

#define CI ccallsc(ci)
char *CI(char v[][5]) {return v[3];}
#define ci_STRV_A1 NUM_ELEMS(6)
FCALLSCFUN1(STRING,ci,STRINGV)

#define CJ ccallsc(cj)
char *CJ(int v) {printf("CJ:v=%d\n",v);return "hello";}
FCALLSCFUN1(STRING,cj,INT)

#ifdef F0_SELECT
PROTOCCALLSFSUB0(fexist)
#define FEXIST()               CCALLSFSUB0(fexist)

main() {FEXIST();}
#endif

#ifdef FA_SELECT
PROTOCCALLSFSUB1(fa,INT)
#define FA(A1)               CCALLSFSUB1(fa,INT,A1)

main() {FA(1234);}
#endif

#ifdef FB_SELECT
PROTOCCALLSFSUB1(fb,PINT)
#define FB(A1)               CCALLSFSUB1(fb,PINT,A1)

main() 
{int i,ii; i=ii=1234; 
 FB(ii); printf("MAIN: FB(i=%d) returns with i=%d.\n",i,ii);}
#endif

#ifdef FC_SELECT
PROTOCCALLSFSUB1(fc,STRING)
#define FC(A1)               CCALLSFSUB1(fc,STRING,A1)

main() {FC("hello");}
#endif

#ifdef FD_SELECT
PROTOCCALLSFSUB1(fd,PSTRING)
#define FD(A1)               CCALLSFSUB1(fd,PSTRING,A1)

main() 
{static char i[] = "happy     "; static char ii[] = "happy      "; 
 FD(ii); printf("MAIN: FD(i=%s) returns with i=%s.\n",i,ii);}
#endif

#ifdef FE_SELECT
PROTOCCALLSFSUB1(fe,STRINGV)
#define FE(A1)               CCALLSFSUB1(fe,STRINGV,A1)

main() 
{static char v[][5] = {"0000", "1", "22", ""}; FE(v);}
#endif

#ifdef FF_SELECT
PROTOCCALLSFSUB2(ff,STRINGV,INT)
#define FF(A1,A2)               CCALLSFSUB2(ff,STRINGV,INT, A1,A2)

main() 
{static char v[][5] = {"0000", "1", "22", ""}; 
 FF(v,sizeof(v)/sizeof v[0]);}
#endif

#ifdef FG_SELECT
PROTOCCALLSFFUN0(INT,fg)
#define FG()               CCALLSFFUN0(fg)

main() 
{printf("FG() returns %d.\n",FG());}
#endif

#ifdef FH_SELECT
PROTOCCALLSFFUN0(STRING,fh)
#define FH()               CCALLSFFUN0(fh)

main() 
{printf("FH() returns %s.\n",FH());}
#endif

#ifdef FI_SELECT
PROTOCCALLSFFUN1(STRING,fi,STRINGV)
#define FI(A1)               CCALLSFFUN1(fi,STRINGV,A1)

main() 
{static char v[][5] = {"0000", "1", "22", "333", "8", "9"}; 
 printf("FI(v) returns %s.\n",FI(v));}
#endif

#ifdef FJ_SELECT
PROTOCCALLSFFUN1(STRING,fj,INT)
#define FJ(A1)               CCALLSFFUN1(fj,INT,A1)

main() 
{ printf("FJ(2) returns %s.\n",FJ(2));}
#endif


#endif
--------------cut for cfortex.for----------------------------------
C cfortex.f
C Burkhard Burow, University of Toronto, July 1990. 

      subroutine s1(b)
      character*(*) b
      character*(13) a
      data a/'first'/
      b = a
      return
      end

      subroutine abc(a,b,c)
      character*(*) b,a,c
      character*(13) d
      d = a
      a = b
      b = c
      c = d
      return
      end

      subroutine forstr1(b)
      character*(*) b
      character*(13) a
      character*(13) forstr
      data a/'firs'/
      b = forstr(a)
      return
      end


      subroutine EASY(a,b)
      a = b
      return
      end

      character*(*) function forstr(a)
      character*(*) a
      forstr = a
      return
      end

      function r(i)
      r = i
      return
      end

      character*(*) function forstr2()
      character*(13) a
      data a/'first'/
      forstr2 = a
      return
      end

      character*(*) function ft(v, w, a)
      character *(*) v(4), w(4)
      print*,'FT:len(v(1 or 2 or 3 or 4))  =',len(v(1))
      print*,'FT:len(w(1 or 2 or 3))    =',len(w(1))
      print*,'FT:a = ',a
      print*,'FT:v(1,2,3,4) =',v(1),',',v(2),',',v(3),',',v(4)
      print*,'FT:w(1,2,3,4) =',w(1),',',w(2),',',w(3),',',w(4)
      ft = v(1)
      return
      end

      subroutine st(v, w, a)
      character *(*) v(4), w(4)
      print*,'ST:len(v(1 or 2 or 3 or 4))  =',len(v(1))
      print*,'ST:len(w(1 or 2 or 3))    =',len(w(1))
      print*,'ST:a = ',a
      print*,'ST:v(1,2,3,4) =',v(1),',',v(2),',',v(3),',',v(4)
      print*,'ST:w(1,2,3,4) =',w(1),',',w(2),',',w(3),',',w(4)
      return
      end

      subroutine rev(a)
      integer a(2),t
      t    = a(1)
      a(1) = a(2)
      a(2) = t
      return
      end

      integer function frev(a)
      integer a(2)
      frev = a(1)
      a(1) = a(2)
      a(2) = frev
      return
      end

      subroutine fexist()
      print*,'FEXIST: was called'
      call exist()
      return
      end

      subroutine fa(i)
      integer i
      print*,'FA: integer argument =',i
      call ca(i)
      return
      end

      subroutine fb(i)
      integer i
      print*,'FB: integer argument =',i
      i = i*2
      call cb(i)
      return
      end

      subroutine fc(b)
      character*(*) b
      print*,'FC: string argument =',b
      call cc(b)
      return
      end

      subroutine fd(b)
      character*(*) b
      character*(13) a
      data a/'birthday'/
      b = a
      call cd(b)
      return
      end

      subroutine fe(v)
      character*(*) v(4)
      print*,'FE:len(v(1 or 2 or 3 or 4))  =',len(v(1))
      print*,'FE:v(1,2,3,4) =',v(1),',',v(2),',',v(3),',',v(4)
      call ce(v)
      return
      end

      subroutine ff(v,n)
      character*(*) v(4)
      print*,'FF:len(v(1 or 2 or 3 or 4))  =',len(v(1))
      print*,'FF:v(1,2,3,4) =',v(1),',',v(2),',',v(3),',',v(4)
      print*,'FF:n =',n
      call cf(v,n)
      return
      end

      integer function fg()
      integer cg
      fg = cg()
      return
      end

      character*(*) function fh()
      character*200 ch
      fh = ch()
      return
      end

      character*(*) function fi(v)
      character*(*) v(6)
      character*200 ci
      fi = ci(v)
      return
      end

      character*(*) function fj(v)
      integer v
      character*200 cj
      print*,'FJ:v =',v
      fj = cj(v)
      return
      end

-----------end of posting---apologies for the lenght---------------------