Path: utzoo!utgpu!news-server.csri.toronto.edu!cs.utexas.edu!uunet!sparky!kent
From: burow@cernvax.cern.ch (Burkhard Burow)
Newsgroups: comp.sources.misc
Subject: v20i067:  cfortran - a bridge between C and FORTRAN, Part02/02
Message-ID: <1991Jun25.193417.29440@sparky.IMD.Sterling.COM>
Date: 25 Jun 91 19:34:17 GMT
References: <csm-v20i066=cfortran.143251@sparky.imd.sterling.com>
Sender: kent@sparky.IMD.Sterling.COM (Kent Landfield)
Organization: Sterling Software, IMD
Lines: 1195
Approved: kent@sparky.imd.sterling.com
X-Md4-Signature: 99448899475aca49f1c8959692bf74a5

Submitted-by: Burkhard Burow <burow@cernvax.cern.ch>
Posting-number: Volume 20, Issue 67
Archive-name: cfortran/part02

#! /bin/sh
# into a shell via "sh file" or similar.  To overwrite existing files,
# type "sh file -c".
# The tool that generated this appeared in the comp.sources.unix newsgroup;
# send mail to comp-sources-unix@uunet.uu.net if you want that tool.
# Contents:  cfortran.h
# Wrapped by kent@sparky on Tue Jun 25 14:25:33 1991
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
echo If this archive is complete, you will see the following message:
echo '          "shar: End of archive 2 (of 2)."'
if test -f 'cfortran.h' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'cfortran.h'\"
else
  echo shar: Extracting \"'cfortran.h'\" \(54924 characters\)
  sed "s/^X//" >'cfortran.h' <<'END_OF_FILE'
X/* cfortran.h */
X/* Burkhard Burow, University of Toronto, 1991. */
X
X#ifndef __CFORTRAN_LOADED
X#define __CFORTRAN_LOADED       1
X
X#if !defined(mips) && !defined(_IBMR2) && !(defined(vms) && defined(VAXC))
X??=error This header file is for the following compilers:
X??=error - MIPS cc and f77 2.0. (e.g. Silicon Graphics, DECstations, ...)
X??=error - IBM AIX XL C and FORTRAN Compiler/6000 Version 01.01.0000.0000
X??=error - VAX VMS CC 3.1 and FORTRAN 5.4.
X#else
X
X#ifdef vms
X#include <descrip.h>
X#endif
X#include <stddef.h>
X#include <stdlib.h>
X#include <string.h>
X
X/* Note that for VMS and IBMR2 (without -Dextname), one may wish to change the
X   defaults for fcallsc and/or ccallsc. */
X
X#if defined(mips) || (defined(_IBMR2) && defined(extname))
X#define C_(A)                  A/**/_
X#define ccallsc(NAME)          NAME
X#else
X#define C_(A)                  A
X#define ccallsc(NAME)          CF/**/NAME
X#endif
X#define fcallsc                C_
X#define C_FUNCTION             fcallsc
X#define FORTRAN_FUNCTION       C_
X#define COMMON_BLOCK           C_
X/*-------------------------------------------------------------------------*/
X
X/*               UTILITIES USED WITHIN CFORTRAN                            */
X
X#define MIN(A,B) (A<B?A:B)
X#define firstindexlength( A) (sizeof(A)     /sizeof(A[0]))
X#define secondindexlength(A) (sizeof((A)[0])/sizeof((A)[0][0]))
X
X/* Convert a vector of C strings into FORTRAN strings. */
Xstatic char *c2fstrv(char* cstr, char *fstr, int elem_len, int sizeofcstr)
X{ int i,j;
X/* elem_len includes \0 for C strings. Fortran strings don't have term. \0.
X   Useful size of string must be the same in both languages. */
Xfor (i=0; i<sizeofcstr/elem_len; i++) {
X  for (j=1; j<elem_len && *cstr; j++) *fstr++ = *cstr++;
X  cstr += 1+elem_len-j;
X  for (; j<elem_len; j++) *fstr++ = ' ';
X}
Xreturn fstr-sizeofcstr+sizeofcstr/elem_len;
X}
X
X/* Convert a vector of FORTRAN strings into C strings. */
Xstatic char *f2cstrv(char *fstr, char* cstr, int elem_len, int sizeofcstr)
X{ int i,j;
X/* elem_len includes \0 for C strings. Fortran strings don't have term. \0.
X   Useful size of string must be the same in both languages. */
Xcstr += sizeofcstr;
Xfstr += sizeofcstr - sizeofcstr/elem_len;
Xfor (i=0; i<sizeofcstr/elem_len; i++) {
X  *--cstr = '\0';
X  for (j=1; j<elem_len; j++) *--cstr = *--fstr;
X}
Xreturn cstr;
X}
X
X/* kill the trailing char t's in string s. */
Xstatic char *kill_trailing(char *s, char t)
X{char *e;
Xe = s + strlen(s);
Xif (e>s) {                           /* Need this to handle NULL string.*/
X  while (e>s && *--e==t);            /* Don't follow t's past beginning. */
X  e[*e==t?0:1] = '\0';               /* Handle s[0]=t correctly.       */
X}
Xreturn s;
X}
X
X/* kill_trailingn(s,t,e) will kill the trailing t's in string s. e normally
Xpoints to the terminating '\0' of s, but may actually point to anywhere in s.
Xs's new '\0' will be placed at e or earlier in order to remove any trailing t's.
XIf e<s string s is left unchanged. */
Xstatic char *kill_trailingn(char *s, char t, char *e)
X{
Xif (e==s) *e = '\0';                 /* Kill the string makes sense here.*/
Xelse if (e>s) {                      /* Watch out for neg. length string.*/
X  while (e>s && *--e==t);            /* Don't follow t's past beginning. */
X  e[*e==t?0:1] = '\0';               /* Handle s[0]=t correctly.       */
X}
Xreturn s;
X}
X
X/* Note the following assumes that any element which has t's to be chopped off,
Xdoes indeed fill the entire element. */
Xstatic char *vkill_trailing(char* cstr, int elem_len, int sizeofcstr, char t)
X{ int i;
Xfor (i=0; i<sizeofcstr/elem_len; i++) /* elem_len includes \0 for C strings. */
X  kill_trailingn(cstr+elem_len*i,t,cstr+elem_len*(i+1)-1);
Xreturn cstr;
X}
X
X#ifdef vms
Xtypedef struct dsc$descriptor_s fstring;
X#define DSC$DESCRIPTOR_A(DIMCT)                                                \
Xstruct {                                                                       \
X  unsigned short dsc$w_length;                                                 \
X  unsigned char  dsc$b_dtype;                                                  \
X  unsigned char  dsc$b_class;                                                  \
X           char *dsc$a_pointer;                                                \
X           char  dsc$b_scale;                                                  \
X  unsigned char dsc$b_digits;                                                  \
X  struct {                                                                     \
X    unsigned                   : 3;                                            \
X    unsigned dsc$v_fl_binscale : 1;                                            \
X    unsigned dsc$v_fl_redim    : 1;                                            \
X    unsigned dsc$v_fl_column   : 1;                                            \
X    unsigned dsc$v_fl_coeff    : 1;                                            \
X    unsigned dsc$v_fl_bounds   : 1;                                            \
X  } dsc$b_aflags;                                                              \
X  unsigned char  dsc$b_dimct;                                                  \
X  unsigned long  dsc$l_arsize;                                                 \
X           char *dsc$a_a0;                                                     \
X           long  dsc$l_m [DIMCT];                                              \
X  struct {                                                                     \
X    long dsc$l_l;                                                              \
X    long dsc$l_u;                                                              \
X  } dsc$bounds [DIMCT];                                                        \
X}
Xtypedef DSC$DESCRIPTOR_A(1) fstringvector;
X/*typedef DSC$DESCRIPTOR_A(2) fstringarrarr;
X  typedef DSC$DESCRIPTOR_A(3) fstringarrarrarr;*/
X#define initfstr(F,C,ELEMNO,ELEMLEN)                                           \
X( (F).dsc$l_arsize=  ( (F).dsc$w_length                        =(ELEMLEN) )    \
X                    *( (F).dsc$l_m[0]=(F).dsc$bounds[0].dsc$l_u=(ELEMNO)  ),   \
X  (F).dsc$a_a0    =  ( (F).dsc$a_pointer=(C) ) - (F).dsc$w_length          ,(F))
X
X#define F2CSTRVCOPY(C,F)                                                       \
X  vkill_trailing(f2cstrv(F->dsc$a_pointer,C,F->dsc$w_length+1,                 \
X                         F->dsc$l_m[0]*(F->dsc$w_length+1)),                   \
X                 F->dsc$w_length+1,F->dsc$l_m[0]*(F->dsc$w_length+1),' ')
X#define C2FSTRVCOPY(C,F) c2fstrv(C,F->dsc$a_pointer,F->dsc$w_length+1,         \
X                                 F->dsc$l_m[0]*(F->dsc$w_length+1)    )
X
X#else
X#define _NUM_ELEMS      -1
X#define _NUM_ELEM_ARG   -2
X#define NUM_ELEMS(A)    A,_NUM_ELEMS
X#define NUM_ELEM_ARG(B) *A/**/B,_NUM_ELEM_ARG
X#define TERM_CHARS(A,B) A,B
Xstatic int num_elem(char *strv, unsigned elem_len, int term_char,
X                    int num_term_char)
X/* elem_len is the number of characters in each element of strv, the FORTRAN
Xvector of strings. The last element of the vector must begin with at least
Xnum_term_char term_char characters, so that this routine can determine how
Xmany elements are in the vector. */
X{
Xunsigned num,i;
Xif (num_term_char == _NUM_ELEMS || num_term_char == _NUM_ELEM_ARG)
X  return term_char;
Xif (num_term_char <=0) num_term_char = elem_len;
Xfor (num=0; ; num++) {
X  for (i=0; i<num_term_char && *strv==term_char; i++,strv++);
X  if (i==num_term_char) break;
X  else strv += elem_len-i;
X}
Xreturn num;
X}
X#endif
X/*-------------------------------------------------------------------------*/
X
X/*           UTILITIES FOR C TO USE STRINGS IN FORTRAN COMMON BLOCKS       */
X
X/* C string TO Fortran Common Block STRing. */
X/* DIM is the number of DIMensions of the array in terms of strings, not
X   characters. e.g. char a[12] has DIM = 0, char a[12][4] has DIM = 1, etc. */
X#define C2FCBSTR(CSTR,FSTR,DIM)                                                \
X c2fstrv((char *)CSTR, (char *)FSTR, sizeof(FSTR)/cfelementsof(FSTR,DIM)+1,    \
X         sizeof(FSTR)+cfelementsof(FSTR,DIM))
X
X/* Fortran Common Block string TO C STRing. */
X#define FCB2CSTR(FSTR,CSTR,DIM)                                                \
X vkill_trailing(f2cstrv((char *)FSTR, (char *)CSTR,                            \
X                        sizeof(FSTR)/cfelementsof(FSTR,DIM)+1,                 \
X                        sizeof(FSTR)+cfelementsof(FSTR,DIM)),                  \
X                sizeof(FSTR)/cfelementsof(FSTR,DIM)+1,                         \
X                sizeof(FSTR)+cfelementsof(FSTR,DIM), ' ')
X
X#define cfDEREFERENCE0
X#define cfDEREFERENCE1 *
X#define cfDEREFERENCE2 **
X#define cfDEREFERENCE3 ***
X#define cfDEREFERENCE4 ****
X#define cfDEREFERENCE5 *****
X#define cfelementsof(A,D) (sizeof(A)/sizeof(cfDEREFERENCE/**/D(A)))
X
X/*-------------------------------------------------------------------------*/
X
X/*               UTILITIES FOR C TO CALL FORTRAN SUBROUTINES               */
X
X/* Define lookup tables for how to handle the various types of variables.  */
X
X#ifdef VAXC        /* To avoid %CC-I-PARAMNOTUSED. */
X#pragma nostandard
X#endif
X
X#define VCF(TN,I)      V/**/TN(A/**/I,B/**/I)
X#define VDOUBLE(  A,B) double  B = A;
X#define VFLOAT(   A,B) float   B = A;
X#define VINT(     A,B) int     B = (int)A;      /* typecast for enum's sake */
X#define VLOGICAL( A,B) int     B = A;
X#define VLONG(    A,B) long    B = A;
X#define VDOUBLEV( A,B) double *B = A;
X#define VFLOATV(  A,B) float  *B = A;
X#define VINTV(    A,B) int    *B = A;
X#define VDOUBLEVV(A,B) double *B = A[0];
X#define VFLOATVV( A,B) float  *B = A[0];
X#define VINTVV(   A,B) int    *B = A[0];
X#define VPDOUBLE( A,B)
X#define VPFLOAT(  A,B)
X#define VPINT(    A,B)
X#define VPLOGICAL(A,B)
X#define VPLONG(   A,B)
X#define VPVOID(   A,B)
X#define VPSTRUCT( A,B)
X#ifdef vms
X#define VSTRING(  A,B) static struct {fstring f; unsigned clen;} B =           \
X                                       {{0,DSC$K_DTYPE_T,DSC$K_CLASS_S,NULL},0};
X#define VPSTRING( A,B) static fstring B={0,DSC$K_DTYPE_T,DSC$K_CLASS_S,NULL};
X#define VSTRINGV( A,B) static fstringvector B =                                \
X{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}};
X#define VPSTRINGV(A,B) static fstringvector B =                                \
X{0,DSC$K_DTYPE_T,DSC$K_CLASS_A,NULL,0,0,{0,0,0,1,1,1},1,0,NULL,0,{1,0}};
X#else
X#define VSTRING(  A,B) struct {unsigned short clen, flen;} B;
X#define VSTRINGV( A,B) struct {char *s; unsigned flen;} B;
X#define VPSTRING( A,B) int     B;
X#define VPSTRINGV(A,B) struct {unsigned short sizeofA, flen;} B;
X#endif
X
X#define ADOUBLE(  A,B) &B
X#define AFLOAT(   A,B) &B
X#define AINT(     A,B) &B
X#define ALOGICAL( A,B) &B
X#define ALONG(    A,B) &B
X#define ADOUBLEV( A,B)  B
X#define AFLOATV(  A,B)  B
X#define AINTV(    A,B)  B
X#define ADOUBLEVV(A,B)  B
X#define AFLOATVV( A,B)  B
X#define AINTVV(   A,B)  B
X#define APDOUBLE( A,B) &A
X#define APFLOAT(A,B)   &A
X#define APINT(    A,B) (int *) & A   /* typecast for enum's sake */
X#define APLOGICAL(A,B) &A
X#define APLONG(   A,B) &A
X#define APVOID(   A,B) (void *) A
X#define APSTRUCT( A,B) (void *)&A
X#define ASTRING(  A,B) CSTRING(A,B,sizeof(A))
X#define APSTRING( A,B) CPSTRING(A,B,sizeof(A))
X#ifdef vms
X#define ASTRINGV( A,B) (initfstr(B,malloc(sizeof(A)-firstindexlength(A)),      \
X                                 firstindexlength(A),secondindexlength(A)-1),  \
X                c2fstrv(A[0],B.dsc$a_pointer,secondindexlength(A),sizeof(A)),&B)
X#define APSTRINGV(A,B) (initfstr(B,A[0],firstindexlength(A),                   \
X                                 secondindexlength(A)-1),                      \
X                        c2fstrv(A[0],A[0],secondindexlength(A),sizeof(A)), &B)
X#else
X#define ASTRINGV( A,B) (B.s=malloc(sizeof(A)-firstindexlength(A)),             \
X                  c2fstrv(A[0],B.s,(B.flen=secondindexlength(A)-1)+1,sizeof(A)))
X#define APSTRINGV(A,B) c2fstrv(A[0],A[0],(B.flen=secondindexlength(A)-1)+1,    \
X                               B.sizeofA=sizeof(A))
X#endif
X
X#define JCF(TN,I)      J/**/TN(A/**/I,B/**/I)
X#define JDOUBLE(  A,B)
X#define JFLOAT(   A,B)
X#define JINT(     A,B)
X#define JLOGICAL( A,B)
X#define JLONG(    A,B)
X#define JDOUBLEV( A,B)
X#define JFLOATV(  A,B)
X#define JINTV(    A,B)
X#define JDOUBLEVV(A,B)
X#define JFLOATVV( A,B)
X#define JINTVV(   A,B)
X#define JPDOUBLE( A,B)
X#define JPFLOAT(  A,B)
X#define JPINT(    A,B)
X#define JPLOGICAL(A,B)
X#define JPLONG(   A,B)
X#define JPVOID(   A,B)
X#define JPSTRUCT( A,B)
X#ifdef vms
X#define JSTRING(  A,B)
X#define JPSTRING( A,B)
X#else
X#define JSTRING(  A,B) ,B.flen
X#define JPSTRING( A,B) ,B
X#endif
X#define JSTRINGV       JSTRING
X#define JPSTRINGV      JSTRING
X
X#define WCF(TN,I)      W/**/TN(A/**/I,B/**/I)
X#define WDOUBLE(  A,B)
X#define WFLOAT(   A,B)
X#define WINT(     A,B)
X#define WLOGICAL( A,B)
X#define WLONG(    A,B)
X#define WDOUBLEV( A,B)
X#define WFLOATV(  A,B)
X#define WINTV(    A,B)
X#define WDOUBLEVV(A,B)
X#define WFLOATVV( A,B)
X#define WINTVV(   A,B)
X#define WPDOUBLE( A,B)
X#define WPFLOAT(  A,B)
X#define WPINT(    A,B)
X#define WPLOGICAL(A,B)
X#define WPLONG(   A,B)
X#define WPVOID(   A,B)
X#define WPSTRUCT( A,B)
X#define WSTRING(  A,B) (A[B.clen]!='\0'?A[B.clen]='\0':0); /* A may be "const"*/
X#define WPSTRING( A,B) kill_trailing(A,' ');
X#ifdef vms
X#define WSTRINGV( A,B) free(B.dsc$a_pointer);
X#define WPSTRINGV(A,B)                                                         \
X  vkill_trailing(f2cstrv((char*)A, (char*)A,                                   \
X                         B.dsc$w_length+1, B.dsc$l_arsize+B.dsc$l_m[0]),       \
X                 B.dsc$w_length+1, B.dsc$l_arsize+B.dsc$l_m[0], ' ');
X#else
X#define WSTRINGV( A,B) free(B.s);
X#define WPSTRINGV(A,B) vkill_trailing(                                         \
X         f2cstrv((char*)A,(char*)A,B.flen+1,B.sizeofA), B.flen+1,B.sizeofA,' ');
X#endif
X
X#define NDOUBLE        double        *
X#define NFLOAT         float         *
X#define NINT           int           *
X#define NLOGICAL       int           *
X#define NLONG          long          *
X#define NDOUBLEV       double        *
X#define NFLOATV        float         *
X#define NINTV          int           *
X#define NFLOATVV       float         *
X#define NINTVV         int           *
X#define NPDOUBLE       double        *
X#define NPFLOAT        float         *
X#define NPINT          int           *
X#define NPLOGICAL      int           *
X#define NPLONG         long          *
X#define NPVOID         void          *
X#define NPSTRUCT       void          *
X#ifdef vms
X#define NSTRING        fstring       *
X#define NSTRINGV       fstringvector *
X#else
X#define NSTRING        char          *
X#define NSTRINGV       char          *
X#endif
X#define NPSTRING       NSTRING
X#define NPSTRINGV      NSTRINGV
X
X#ifdef VAXC        /* Have avoid %CC-I-PARAMNOTUSED. */
X#pragma standard
X#endif
X
X#define CCALLSFSUB0(NAME) {C_(NAME)();}
X
X#define CCALLSFSUB1(NAME,T1,A1)                                                \
X{V/**/T1(A1,B1) C_(NAME)(A/**/T1(A1,B1) J/**/T1(A1,B1)); W/**/T1(A1,B1)}
X
X#define CCALLSFSUB2(NAME,T1,T2,A1,A2)                                          \
X{V/**/T1(A1,B1) V/**/T2(A2,B2)                                                 \
X C_(NAME)(A/**/T1(A1,B1),A/**/T2(A2,B2) J/**/T1(A1,B1) J/**/T2(A2,B2));        \
X W/**/T1(A1,B1) W/**/T2(A2,B2)}
X
X#define CCALLSFSUB3(NAME,T1,T2,T3,A1,A2,A3)                                    \
X{V/**/T1(A1,B1) V/**/T2(A2,B2) V/**/T3(A3,B3)                                  \
X C_(NAME)(A/**/T1(A1,B1),A/**/T2(A2,B2),A/**/T3(A3,B3)                         \
X          J/**/T1(A1,B1) J/**/T2(A2,B2) J/**/T3(A3,B3));                       \
X W/**/T1(A1,B1) W/**/T2(A2,B2) W/**/T3(A3,B3)}
X
X#define CCALLSFSUB4(NAME,T1,T2,T3,T4,A1,A2,A3,A4)                              \
X{V/**/T1(A1,B1) V/**/T2(A2,B2) V/**/T3(A3,B3) V/**/T4(A4,B4)                   \
X C_(NAME)(A/**/T1(A1,B1),A/**/T2(A2,B2),A/**/T3(A3,B3),A/**/T4(A4,B4)          \
X          J/**/T1(A1,B1) J/**/T2(A2,B2) J/**/T3(A3,B3) J/**/T4(A4,B4));        \
X W/**/T1(A1,B1) W/**/T2(A2,B2) W/**/T3(A3,B3) W/**/T4(A4,B4)}
X
X#define CCALLSFSUB5(NAME,T1,T2,T3,T4,T5,A1,A2,A3,A4,A5)                        \
X{V/**/T1(A1,B1) V/**/T2(A2,B2) V/**/T3(A3,B3) V/**/T4(A4,B4) V/**/T5(A5,B5)    \
X C_(NAME)(A/**/T1(A1,B1),A/**/T2(A2,B2),A/**/T3(A3,B3),A/**/T4(A4,B4),         \
X          A/**/T5(A5,B5) J/**/T1(A1,B1) J/**/T2(A2,B2) J/**/T3(A3,B3)          \
X          J/**/T4(A4,B4) J/**/T5(A5,B5));                                      \
X W/**/T1(A1,B1) W/**/T2(A2,B2) W/**/T3(A3,B3) W/**/T4(A4,B4) W/**/T5(A5,B5)}
X
X#define CCALLSFSUB6(NAME,T1,T2,T3,T4,T5,T6,A1,A2,A3,A4,A5,A6)                  \
X{V/**/T1(A1,B1) V/**/T2(A2,B2) V/**/T3(A3,B3) V/**/T4(A4,B4)                   \
X V/**/T5(A5,B5) V/**/T6(A6,B6)                                                 \
X C_(NAME)(A/**/T1(A1,B1),A/**/T2(A2,B2),A/**/T3(A3,B3),A/**/T4(A4,B4),         \
X          A/**/T5(A5,B5),A/**/T6(A6,B6) J/**/T1(A1,B1) J/**/T2(A2,B2)          \
X          J/**/T3(A3,B3) J/**/T4(A4,B4) J/**/T5(A5,B5) J/**/T6(A6,B6));        \
X W/**/T1(A1,B1) W/**/T2(A2,B2) W/**/T3(A3,B3) W/**/T4(A4,B4)                   \
X W/**/T5(A5,B5) W/**/T6(A6,B6)}
X
X#define CCALLSFSUB7(NAME,T1,T2,T3,T4,T5,T6,T7,A1,A2,A3,A4,A5,A6,A7)            \
X{V/**/T1(A1,B1) V/**/T2(A2,B2) V/**/T3(A3,B3) V/**/T4(A4,B4)                   \
X V/**/T5(A5,B5) V/**/T6(A6,B6) V/**/T7(A7,B7)                                  \
X C_(NAME)(A/**/T1(A1,B1),A/**/T2(A2,B2),A/**/T3(A3,B3),A/**/T4(A4,B4),         \
X          A/**/T5(A5,B5),A/**/T6(A6,B6),A/**/T7(A7,B7)                         \
X          J/**/T1(A1,B1) J/**/T2(A2,B2) J/**/T3(A3,B3) J/**/T4(A4,B4)          \
X          J/**/T5(A5,B5) J/**/T6(A6,B6) J/**/T7(A7,B7));                       \
X W/**/T1(A1,B1) W/**/T2(A2,B2) W/**/T3(A3,B3) W/**/T4(A4,B4)                   \
X W/**/T5(A5,B5) W/**/T6(A6,B6) W/**/T7(A7,B7)}
X
X#define CCALLSFSUB8(NAME,T1,T2,T3,T4,T5,T6,T7,T8,A1,A2,A3,A4,A5,A6,A7,A8)      \
X{V/**/T1(A1,B1) V/**/T2(A2,B2) V/**/T3(A3,B3) V/**/T4(A4,B4)                   \
X V/**/T5(A5,B5) V/**/T6(A6,B6) V/**/T7(A7,B7) V/**/T8(A8,B8)                   \
X C_(NAME)(A/**/T1(A1,B1),A/**/T2(A2,B2),A/**/T3(A3,B3),A/**/T4(A4,B4),         \
X          A/**/T5(A5,B5),A/**/T6(A6,B6),A/**/T7(A7,B7),A/**/T8(A8,B8)          \
X          J/**/T1(A1,B1) J/**/T2(A2,B2) J/**/T3(A3,B3) J/**/T4(A4,B4)          \
X          J/**/T5(A5,B5) J/**/T6(A6,B6) J/**/T7(A7,B7) J/**/T8(A8,B8));        \
X W/**/T1(A1,B1) W/**/T2(A2,B2) W/**/T3(A3,B3) W/**/T4(A4,B4)                   \
X W/**/T5(A5,B5) W/**/T6(A6,B6) W/**/T7(A7,B7) W/**/T8(A8,B8)}
X
X#define CCALLSFSUB9(NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9,A1,A2,A3,A4,A5,A6,A7,A8,A9)\
X{V/**/T1(A1,B1) V/**/T2(A2,B2) V/**/T3(A3,B3) V/**/T4(A4,B4)                   \
X V/**/T5(A5,B5) V/**/T6(A6,B6) V/**/T7(A7,B7) V/**/T8(A8,B8) V/**/T9(A9,B9)    \
X C_(NAME)(A/**/T1(A1,B1),A/**/T2(A2,B2),A/**/T3(A3,B3),A/**/T4(A4,B4),         \
X          A/**/T5(A5,B5),A/**/T6(A6,B6),A/**/T7(A7,B7),A/**/T8(A8,B8),         \
X          A/**/T9(A9,B9) J/**/T1(A1,B1) J/**/T2(A2,B2) J/**/T3(A3,B3)          \
X          J/**/T4(A4,B4) J/**/T5(A5,B5) J/**/T6(A6,B6) J/**/T7(A7,B7)          \
X          J/**/T8(A8,B8) J/**/T9(A9,B9));                                      \
X W/**/T1(A1,B1) W/**/T2(A2,B2) W/**/T3(A3,B3) W/**/T4(A4,B4)                   \
X W/**/T5(A5,B5) W/**/T6(A6,B6) W/**/T7(A7,B7) W/**/T8(A8,B8) W/**/T9(A9,B9)}
X
X#define CCALLSFSUB10(NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,                       \
X                          A1,A2,A3,A4,A5,A6,A7,A8,A9,AA)                       \
X{V/**/T1(A1,B1) V/**/T2(A2,B2) V/**/T3(A3,B3) V/**/T4(A4,B4) V/**/T5(A5,B5)    \
X V/**/T6(A6,B6) V/**/T7(A7,B7) V/**/T8(A8,B8) V/**/T9(A9,B9) V/**/TA(AA,BA)    \
X C_(NAME)(A/**/T1(A1,B1),A/**/T2(A2,B2),A/**/T3(A3,B3),A/**/T4(A4,B4),         \
X          A/**/T5(A5,B5),A/**/T6(A6,B6),A/**/T7(A7,B7),A/**/T8(A8,B8),         \
X          A/**/T9(A9,B9),A/**/TA(AA,BA) J/**/T1(A1,B1) J/**/T2(A2,B2)          \
X          J/**/T3(A3,B3) J/**/T4(A4,B4) J/**/T5(A5,B5) J/**/T6(A6,B6)          \
X          J/**/T7(A7,B7) J/**/T8(A8,B8) J/**/T9(A9,B9) J/**/TA(AA,BA));        \
X W/**/T1(A1,B1) W/**/T2(A2,B2) W/**/T3(A3,B3) W/**/T4(A4,B4) W/**/T5(A5,B5)    \
X W/**/T6(A6,B6) W/**/T7(A7,B7) W/**/T8(A8,B8) W/**/T9(A9,B9) W/**/TA(AA,BA) }
X
X#define CCALLSFSUB11(NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,                    \
X                          A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB)                    \
X{V/**/T1(A1,B1) V/**/T2(A2,B2) V/**/T3(A3,B3) V/**/T4(A4,B4) V/**/T5(A5,B5)    \
X V/**/T6(A6,B6) V/**/T7(A7,B7) V/**/T8(A8,B8) V/**/T9(A9,B9) V/**/TA(AA,BA)    \
X V/**/TB(AB,BB)                                                                \
X C_(NAME)(A/**/T1(A1,B1),A/**/T2(A2,B2),A/**/T3(A3,B3),A/**/T4(A4,B4),         \
X          A/**/T5(A5,B5),A/**/T6(A6,B6),A/**/T7(A7,B7),A/**/T8(A8,B8),         \
X          A/**/T9(A9,B9),A/**/TA(AA,BA),A/**/TB(AB,BB) J/**/T1(A1,B1)          \
X          J/**/T2(A2,B2) J/**/T3(A3,B3) J/**/T4(A4,B4) J/**/T5(A5,B5)          \
X          J/**/T6(A6,B6) J/**/T7(A7,B7) J/**/T8(A8,B8) J/**/T9(A9,B9)          \
X          J/**/TA(AA,BA) J/**/TB(AB,BB));                                      \
X W/**/T1(A1,B1) W/**/T2(A2,B2) W/**/T3(A3,B3) W/**/T4(A4,B4) W/**/T5(A5,B5)    \
X W/**/T6(A6,B6) W/**/T7(A7,B7) W/**/T8(A8,B8) W/**/T9(A9,B9) W/**/TA(AA,BA)    \
X W/**/TB(AB,BB) }
X
X#define CCALLSFSUB16(NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,     \
X                          A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG)     \
X{V/**/T1(A1,B1) V/**/T2(A2,B2) V/**/T3(A3,B3) V/**/T4(A4,B4) V/**/T5(A5,B5)    \
X V/**/T6(A6,B6) V/**/T7(A7,B7) V/**/T8(A8,B8) V/**/T9(A9,B9) V/**/TA(AA,BA)    \
X V/**/TB(AB,BB) V/**/TC(AC,BC) V/**/TD(AD,BD) V/**/TE(AE,BE) V/**/TF(AF,BF)    \
X V/**/TG(AG,BG)                                                                \
X C_(NAME)(A/**/T1(A1,B1),A/**/T2(A2,B2),A/**/T3(A3,B3),A/**/T4(A4,B4),         \
X          A/**/T5(A5,B5),A/**/T6(A6,B6),A/**/T7(A7,B7),A/**/T8(A8,B8),         \
X          A/**/T9(A9,B9),A/**/TA(AA,BA),A/**/TB(AB,BB),A/**/TC(AC,BC),         \
X          A/**/TD(AD,BD),A/**/TE(AE,BE),A/**/TF(AF,BF),A/**/TG(AG,BG)          \
X          J/**/T1(A1,B1) J/**/T2(A2,B2) J/**/T3(A3,B3) J/**/T4(A4,B4)          \
X          J/**/T5(A5,B5) J/**/T6(A6,B6) J/**/T7(A7,B7) J/**/T8(A8,B8)          \
X          J/**/T9(A9,B9) J/**/TA(AA,BA) J/**/TB(AB,BB) J/**/TC(AC,BC)          \
X          J/**/TD(AD,BD) J/**/TE(AE,BE) J/**/TF(AF,BF) J/**/TG(AG,BG));        \
X W/**/T1(A1,B1) W/**/T2(A2,B2) W/**/T3(A3,B3) W/**/T4(A4,B4) W/**/T5(A5,B5)    \
X W/**/T6(A6,B6) W/**/T7(A7,B7) W/**/T8(A8,B8) W/**/T9(A9,B9) W/**/TA(AA,BA)    \
X W/**/TB(AB,BB) W/**/TC(AC,BC) W/**/TD(AD,BD) W/**/TE(AE,BE) W/**/TF(AF,BF)    \
X W/**/TG(AG,BG) }
X
X#define PROTOCCALLSFSUB0(NAME) void C_(NAME)();
X#define PROTOCCALLSFSUB1(NAME,T1) void C_(NAME)(N/**/T1, ...);
X#define PROTOCCALLSFSUB2(NAME,T1,T2) void C_(NAME)(N/**/T1,N/**/T2, ...);
X#define PROTOCCALLSFSUB3(NAME,T1,T2,T3) void C_(NAME)(N/**/T1,N/**/T2,N/**/T3, \
X                                                      ...);
X#define PROTOCCALLSFSUB4(NAME,T1,T2,T3,T4)                                     \
X                    void C_(NAME)(N/**/T1,N/**/T2,N/**/T3,N/**/T4, ...);
X#define PROTOCCALLSFSUB5(NAME,T1,T2,T3,T4,T5)                                  \
X                    void C_(NAME)(N/**/T1,N/**/T2,N/**/T3,N/**/T4,N/**/T5, ...);
X#define PROTOCCALLSFSUB6(NAME,T1,T2,T3,T4,T5,T6)                               \
X                    void C_(NAME)(N/**/T1,N/**/T2,N/**/T3,N/**/T4,N/**/T5,     \
X                                  N/**/T6, ...);
X#define PROTOCCALLSFSUB7(NAME,T1,T2,T3,T4,T5,T6,T7)                            \
X                    void C_(NAME)(N/**/T1,N/**/T2,N/**/T3,N/**/T4,N/**/T5,     \
X                                  N/**/T6,N/**/T7, ...);
X#define PROTOCCALLSFSUB8(NAME,T1,T2,T3,T4,T5,T6,T7,T8)                         \
X                    void C_(NAME)(N/**/T1,N/**/T2,N/**/T3,N/**/T4,N/**/T5,     \
X                                  N/**/T6,N/**/T7,N/**/T8, ...);
X#define PROTOCCALLSFSUB9(NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9)                      \
X                    void C_(NAME)(N/**/T1,N/**/T2,N/**/T3,N/**/T4,N/**/T5,     \
X                                  N/**/T6,N/**/T7,N/**/T8,N/**/T9, ...);
X#define PROTOCCALLSFSUB10(NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA)                  \
X                    void C_(NAME)(N/**/T1,N/**/T2,N/**/T3,N/**/T4,N/**/T5,     \
X                                  N/**/T6,N/**/T7,N/**/T8,N/**/T9,N/**/TA, ...);
X#define PROTOCCALLSFSUB11(NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB)               \
X                    void C_(NAME)(N/**/T1,N/**/T2,N/**/T3,N/**/T4,N/**/T5,     \
X                                  N/**/T6,N/**/T7,N/**/T8,N/**/T9,N/**/TA,     \
X                                  N/**/TB, ...);
X#define PROTOCCALLSFSUB16(NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG)\
X                    void C_(NAME)(N/**/T1,N/**/T2,N/**/T3,N/**/T4,N/**/T5,     \
X                                  N/**/T6,N/**/T7,N/**/T8,N/**/T9,N/**/TA,     \
X                                  N/**/TB,N/**/TC,N/**/TD,N/**/TE,N/**/TF,     \
X                                  N/**/TG, ...);
X
X/*-------------------------------------------------------------------------*/
X
X/*               UTILITIES FOR C TO CALL FORTRAN FUNCTIONS                 */
X
X/*N.B. PROTOCCALLSFFUNn(..) generates code, whether or not the FORTRAN
X  function is called. Therefore, especially for creator's of C header files
X  for large FORTRAN libraries which include many functions, to reduce
X  compile time and object code size, it may be desirable to create
X  preprocessor directives to allow users to create code for only those
X  functions which they use.                                                */
X
X/* The following defines the maximum length string that a function can return.
X   Of course it may be undefine-d and re-define-d before individual
X   PROTOCCALLSFFUNn(..) as required.                                       */
X#define MAX_LEN_FORTRAN_FUNCTION_STRING 0x4FE
X
X/* The following defines a character used by CFORTRAN to flag the end of a
X   string coming out of a FORTRAN routine.                                 */
X#define CFORTRAN_NON_CHAR 0x7F
X
X/* Define lookup tables for how to handle the various types of variables.
X   Tables used by for value  returnde by - function:  U,E,G,X
X                                         - arguments: U,B,D,W
X   Note that W... tables are from above.                                   */
X#ifdef VAXC        /* To avoid %CC-I-PARAMNOTUSED. */
X#pragma nostandard
X#endif
X
X#define UDOUBLE        double
X#define UFLOAT         float
X#define UINT           int
X#define ULOGICAL       int
X#define ULONG          long
X#define UFLOATV        float  *
X#define UINTV          int    *
X#define UDOUBLEVV      double *
X#define UFLOATVV       float  *
X#define UINTVV         int    *
X#define UPDOUBLE       double *
X#define UPFLOAT        float  *
X#define UPINT          int    *
X#define UPLOGICAL      int    *
X#define UPLONG         long   *
X#define UPVOID         void   *
X#define UPSTRUCT       void   *
X#define UVOID          void   * /*Needed for FORTRAN calls to C subroutines. */
X#define USTRING        char   *
X#define USTRINGV       char   *
X#define UPSTRING       char   *
X#define UPSTRINGV      char   *
X
X#define EDOUBLE        double A0;
X#define EFLOAT         float  A0;
X#define EINT           int    A0;
X#define ELOGICAL       int    A0;
X#define ELONG          long   A0;
X#ifdef vms
X#define ESTRING        static char AA0[MAX_LEN_FORTRAN_FUNCTION_STRING+1];     \
X                       static fstring A0 =                                     \
X             {MAX_LEN_FORTRAN_FUNCTION_STRING,DSC$K_DTYPE_T,DSC$K_CLASS_S,AA0};\
X               memset(AA0, CFORTRAN_NON_CHAR, MAX_LEN_FORTRAN_FUNCTION_STRING);\
X                                    *(AA0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0';
X#else
X#define ESTRING        static char A0[MAX_LEN_FORTRAN_FUNCTION_STRING+1];      \
X                       memset(A0, CFORTRAN_NON_CHAR,                           \
X                              MAX_LEN_FORTRAN_FUNCTION_STRING);                \
X                       *(A0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0';
X#endif
X/* ESTRING must use static char. array which is guaranteed to exist after
X   function returns.                                                     */
X
X/* N.B.i) The diff. for 0 (Zero) and >=1 arguments.
X       ii)That the folowing create a single unmatched '(' bracket, which
X          must of course be matched in the call.
X       iii)Commas must be handled very carefully                         */
X#define GZDOUBLE(   B) A0=C_(B)(
X#define GZFLOAT(    B) A0=C_(B)(
X#define GZINT(      B) A0=C_(B)(
X#define GZLOGICAL(  B) A0=C_(B)(
X#define GZLONG(     B) A0=C_(B)(
X#ifdef vms
X#define GZSTRING(   B) B(&A0
X#else
X#define GZSTRING(   B) C_(B)(A0,MAX_LEN_FORTRAN_FUNCTION_STRING
X#endif
X
X#define GDOUBLE(    B) A0=C_(B)(
X#define GFLOAT(     B) A0=C_(B)(
X#define GINT(       B) A0=C_(B)(
X#define GLOGICAL(   B) A0=C_(B)(
X#define GLONG(      B) A0=C_(B)(
X#define GSTRING(    B) GZSTRING(B),
X
X#define BDOUBLE(    A) (double)   A
X#define BFLOAT(     A) (float)    A
X#define BINT(       A) (int)      A    /* typecast for enum's sake */
X#define BLOGICAL(   A) (int)      A
X#define BLONG(      A) (long)     A
X#define BSTRING(    A) (char *)   A
X#define BFLOATV(    A)            A
X#define BINTV(      A)            A
X#define BSTRINGV(   A) (char *)   A
X#define BFLOATVV(   A)           (A)[0]
X#define BINTVV(     A)           (A)[0]
X#define BPDOUBLE(   A)           &A
X#define BPFLOAT(    A)           &A
X#define BPINT(      A)           &A /*no longer typecast for enum*/
X#define BPLOGICAL(  A)           &A
X#define BPLONG(     A)           &A
X#define BPSTRING(   A) (char *)   A
X#define BPSTRINGV(  A) (char *)   A
X#define BPVOID(     A) (void *)   A
X#define BPSTRUCT(   A) (void *)  &A
X
X#define SDOUBLE(    A)
X#define SFLOAT(     A)
X#define SINT(       A)
X#define SLOGICAL(   A)
X#define SLONG(      A)
X#define SSTRING(    A) ,sizeof(A)
X#define SFLOATV(    A)
X#define SINTV(      A)
X#define SSTRINGV(   A) ,( (unsigned)0xFFFF*firstindexlength(A)                 \
X                         +secondindexlength(A))
X#define SFLOATVV(   A)
X#define SINTVV(     A)
X#define SPDOUBLE(   A)
X#define SPFLOAT(    A)
X#define SPINT(      A)
X#define SPLOGICAL(  A)
X#define SPLONG(     A)
X#define SPSTRING(   A) ,sizeof(A)
X#define SPSTRINGV      SSTRINGV
X#define SPVOID(     A)
X#define SPSTRUCT(   A)
X
X#define HDOUBLE(    A)
X#define HFLOAT(     A)
X#define HINT(       A)
X#define HLOGICAL(   A)
X#define HLONG(      A)
X#define HSTRING(    A) ,unsigned A
X#define HFLOATV(    A)
X#define HINTV(      A)
X#define HSTRINGV(   A) ,unsigned A
X#define HFLOATVV(   A)
X#define HINTVV(     A)
X#define HPDOUBLE(   A)
X#define HPFLOAT(    A)
X#define HPINT(      A)
X#define HPLOGICAL(  A)
X#define HPLONG(     A)
X#define HPSTRING(   A) ,unsigned A
X#define HPSTRINGV(  A) ,unsigned A
X#define HPVOID(     A)
X#define HPSTRUCT(   A)
X
X#define CCF(TN,I)        C/**/TN(A/**/I,B/**/I,C/**/I)
X#define CDOUBLE(  A,B,C) &A
X#define CFLOAT(   A,B,C) &A
X#define CINT(     A,B,C) &A
X#define CLOGICAL( A,B,C) &A
X#define CLONG(    A,B,C) &A
X#define CFLOATV(  A,B,C)  A
X#define CINTV(    A,B,C)  A
X#define CFLOATVV( A,B,C)  A
X#define CINTVV(   A,B,C)  A
X#define CPDOUBLE( A,B,C)  A
X#define CPFLOAT(  A,B,C)  A
X#define CPINT(    A,B,C)  A         /* typecast for enum's sake */
X#define CPLOGICAL(A,B,C)  A
X#define CPLONG(   A,B,C)  A
X#define CPVOID(   A,B,C)  A
X#define CPSTRUCT( A,B,C)  A
X#ifdef vms
X#define CSTRING(  A,B,C) (B.clen=strlen(A),B.f.dsc$a_pointer=A,                \
X                    C==sizeof(char*)||C==B.clen+1?B.f.dsc$w_length=B.clen,&B.f:\
X          (memset((A)+B.clen,' ',C-B.clen-1),A[B.f.dsc$w_length=C-1]='\0',&B.f))
X#define CSTRINGV( A,B,C) (                                                     \
X          initfstr(B, malloc((C/0xFFFF)*(C%0xFFFF-1)), C/0xFFFF, C%0xFFFF-1),  \
X          c2fstrv(A,B.dsc$a_pointer,C%0xFFFF,(C/0xFFFF)*(C%0xFFFF))         ,&B)
X#define CPSTRING( A,B,C) (B.dsc$w_length=strlen(A),B.dsc$a_pointer=A,          \
X        C==sizeof(char*)?&B:(memset((A)+B.dsc$w_length,' ',C-B.dsc$w_length-1),\
X                             A[B.dsc$w_length=C-1]='\0',&B))
X#define CPSTRINGV(A,B,C)  (initfstr(B, A, C/0xFFFF, C%0xFFFF-1),               \
X                           c2fstrv(A,A,C%0xFFFF,(C/0xFFFF)*(C%0xFFFF)) ,&B)
X#else
X#define CSTRING(  A,B,C) (B.clen=strlen(A),                                    \
X                          C==sizeof(char*)||C==B.clen+1?B.flen=B.clen,(A):     \
X                     (memset((A)+B.clen,' ',C-B.clen-1),A[B.flen=C-1]='\0',(A)))
X#define CSTRINGV( A,B,C) (B.s=malloc((C/0xFFFF)*(C%0xFFFF-1)),                 \
X                     c2fstrv(A,B.s,(B.flen=C%0xFFFF-1)+1,(C/0xFFFF)*(C%0xFFFF)))
X#define CPSTRING( A,B,C) (B=strlen(A), C==sizeof(char*)?(A):                   \
X                          (memset((A)+B,' ',C-B-1),A[B=C-1]='\0',(A)))
X#define CPSTRINGV(A,B,C) c2fstrv(A,A,(B.flen=C%0xFFFF-1)+1,                    \
X                                 B.sizeofA=(C/0xFFFF)*(C%0xFFFF))
X#endif
X
X#define XDOUBLE        return A0;
X#define XFLOAT         return A0;
X#define XINT           return A0;
X#define XLOGICAL       return A0;
X#define XLONG          return A0;
X#ifdef vms
X#define XSTRING        return kill_trailing(                                   \
X                                      kill_trailing(AA0,CFORTRAN_NON_CHAR),' ');
X#else
X#define XSTRING        return kill_trailing(                                   \
X                                      kill_trailing( A0,CFORTRAN_NON_CHAR),' ');
X#endif
X
X#ifdef VAXC        /* Have avoided %CC-I-PARAMNOTUSED. */
X#pragma standard
X#endif
X
X#define CFFUN(NAME) __cf__/**/NAME
X
X#define CCALLSFFUN0(NAME) CFFUN(NAME)()
X
X#define CCALLSFFUN1(NAME,T1,A1) CFFUN(NAME)(B/**/T1(A1) S/**/T1(A1))
X
X#define CCALLSFFUN2(NAME,T1,T2,A1,A2) CFFUN(NAME)(B/**/T1(A1),B/**/T2(A2)      \
X                                                  S/**/T1(A1) S/**/T2(A2))
X
X#define CCALLSFFUN3(NAME,T1,T2,T3,A1,A2,A3)                                    \
XCFFUN(NAME)(B/**/T1(A1),B/**/T2(A2),B/**/T3(A3)                                \
X            S/**/T1(A1) S/**/T2(A2) S/**/T3(A3))
X
X#define CCALLSFFUN4(NAME,T1,T2,T3,T4,A1,A2,A3,A4)                              \
XCFFUN(NAME)(B/**/T1(A1),B/**/T2(A2),B/**/T3(A3),B/**/T4(A4)                    \
X            S/**/T1(A1) S/**/T2(A2) S/**/T3(A3) S/**/T4(A4))
X
X#define CCALLSFFUN5(NAME,T1,T2,T3,T4,T5,A1,A2,A3,A4,A5)                        \
XCFFUN(NAME)(B/**/T1(A1),B/**/T2(A2),B/**/T3(A3),B/**/T4(A4),B/**/T5(A5)        \
X            S/**/T1(A1) S/**/T2(A2) S/**/T3(A3) S/**/T4(A4) S/**/T5(A5))
X
X#define CCALLSFFUN6(NAME,T1,T2,T3,T4,T5,T6,A1,A2,A3,A4,A5,A6)                  \
XCFFUN(NAME)(B/**/T1(A1),B/**/T2(A2),B/**/T3(A3),B/**/T4(A4),B/**/T5(A5)        \
X            B/**/T6(A6)                                                        \
XS/**/T1(A1) S/**/T2(A2) S/**/T3(A3) S/**/T4(A4) S/**/T5(A5) S/**/T6(A6))
X
X#define CCALLSFFUN7(NAME,T1,T2,T3,T4,T5,T6,T7,A1,A2,A3,A4,A5,A6,A7)            \
XCFFUN(NAME)(B/**/T1(A1),B/**/T2(A2),B/**/T3(A3),B/**/T4(A4),B/**/T5(A5)        \
X            B/**/T6(A6),B/**/T7(A7) S/**/T1(A1) S/**/T2(A2) S/**/T3(A3)        \
X            S/**/T4(A4) S/**/T5(A5) S/**/T6(A6) S/**/T7(A7))
X
X#define CCALLSFFUN8(NAME,T1,T2,T3,T4,T5,T6,T7,T8,A1,A2,A3,A4,A5,A6,A7,A8)      \
XCFFUN(NAME)(B/**/T1(A1),B/**/T2(A2),B/**/T3(A3),B/**/T4(A4),B/**/T5(A5)        \
X            B/**/T6(A6),B/**/T7(A7),B/**/T8(A8) S/**/T1(A1) S/**/T2(A2)        \
X            S/**/T3(A3) S/**/T4(A4) S/**/T5(A5) S/**/T6(A6) S/**/T7(A7)        \
X            S/**/T8(A8))
X
X#define CCALLSFFUN9(NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9,A1,A2,A3,A4,A5,A6,A7,A8,A9)\
XCFFUN(NAME)(B/**/T1(A1),B/**/T2(A2),B/**/T3(A3),B/**/T4(A4),B/**/T5(A5)        \
X            B/**/T6(A6),B/**/T7(A7),B/**/T8(A8),B/**/T9(A9) S/**/T1(A1)        \
X            S/**/T2(A2) S/**/T3(A3) S/**/T4(A4) S/**/T5(A5) S/**/T6(A6)        \
X            S/**/T7(A7) S/**/T8(A8) S/**/T9(A9))
X
X/*  N.B. Create a separate function instead of using (call function, function
Xvalue here) because in order to create the variables needed for the input
Xarg.'s which may be const.'s one has to do the creation within {}, but these
Xcan never be placed within ()'s. Therefore one must create wrapper functions.
Xgcc, on the other hand may be able to avoid the wrapper functions. */
X
X#define PROTOCCALLSFFUN0(F,NAME)                                               \
XU/**/F NAME(); /* This is needed to correctly handle the value returned        \
XN.B. Can only have prototype arg.'s with difficulty, a la G... table since     \
XFORTRAN functions returning strings have extra arg.'s. Don't bother, since     \
Xthis only causes a compiler warning to come up when one uses FCALLSCFUNn and   \
XCCALLSFFUNn for the same function in the same source code. Something done by   \
Xthe experts in tests only.*/                                                   \
Xstatic U/**/F CFFUN(NAME)() {E/**/F  GZ/**/F(NAME)); X/**/F}
X
X#define PROTOCCALLSFFUN1(F,NAME,T1)                                            \
XU/**/F C_(NAME)();                                                             \
Xstatic U/**/F CFFUN(NAME)(U/**/T1 A1 H/**/T1(C1))                              \
X{VCF(T1,1) E/**/F G/**/F(NAME)CCF(T1,1) JCF(T1,1)); WCF(T1,1) X/**/F}
X
X#define PROTOCCALLSFFUN2(F,NAME,T1,T2)                                         \
XU/**/F C_(NAME)();                                                             \
Xstatic U/**/F CFFUN(NAME)(U/**/T1 A1,U/**/T2 A2 H/**/T1(C1) H/**/T2(C2))       \
X{VCF(T1,1) VCF(T2,2) E/**/F G/**/F(NAME)CCF(T1,1),CCF(T2,2)                    \
X JCF(T1,1) JCF(T2,2)); WCF(T1,1) WCF(T2,2) X/**/F}
X
X#define PROTOCCALLSFFUN3(F,NAME,T1,T2,T3)                                      \
XU/**/F C_(NAME)();                                                             \
Xstatic U/**/F CFFUN(NAME)(U/**/T1 A1,U/**/T2 A2,U/**/T3 A3                     \
X                          H/**/T1(C1) H/**/T2(C2) H/**/T3(C3))                 \
X{VCF(T1,1) VCF(T2,2) VCF(T3,3) E/**/F                                          \
X G/**/F(NAME)CCF(T1,1),CCF(T2,2),CCF(T3,3) JCF(T1,1) JCF(T2,2) JCF(T3,3));     \
X WCF(T1,1) WCF(T2,2) WCF(T3,3) X/**/F}
X
X#define PROTOCCALLSFFUN4(F,NAME,T1,T2,T3,T4)                                   \
XU/**/F C_(NAME)();                                                             \
Xstatic U/**/F CFFUN(NAME)(U/**/T1 A1,U/**/T2 A2,U/**/T3 A3,U/**/T4 A4          \
X                          H/**/T1(C1) H/**/T2(C2) H/**/T3(C3) H/**/T4(C4))     \
X{VCF(T1,1) VCF(T2,2) VCF(T3,3) VCF(T4,4) E/**/F                                \
X G/**/F(NAME)CCF(T1,1),CCF(T2,2),CCF(T3,3),CCF(T4,4) JCF(T1,1) JCF(T2,2)       \
X JCF(T3,3) JCF(T4,4)); WCF(T1,1) WCF(T2,2) WCF(T3,3) WCF(T4,4) X/**/F}
X
X#define PROTOCCALLSFFUN5(F,NAME,T1,T2,T3,T4,T5)                                \
XU/**/F C_(NAME)();                                                             \
Xstatic U/**/F CFFUN(NAME)(U/**/T1 A1,U/**/T2 A2,U/**/T3 A3,U/**/T4 A4,         \
X   U/**/T5 A5 H/**/T1(C1) H/**/T2(C2) H/**/T3(C3) H/**/T4(C4) H/**/T5(C5))     \
X{VCF(T1,1) VCF(T2,2) VCF(T3,3) VCF(T4,4) VCF(T5,5) E/**/F                      \
X G/**/F(NAME)CCF(T1,1),CCF(T2,2),CCF(T3,3),CCF(T4,4),CCF(T5,5)                 \
X JCF(T1,1) JCF(T2,2) JCF(T3,3) JCF(T4,4) JCF(T5,5));                           \
X WCF(T1,1) WCF(T2,2) WCF(T3,3) WCF(T4,4) WCF(T5,5) X/**/F}
X
X#define PROTOCCALLSFFUN6(F,NAME,T1,T2,T3,T4,T5,T6)                             \
XU/**/F C_(NAME)();                                                             \
Xstatic U/**/F CFFUN(NAME)(U/**/T1 A1,U/**/T2 A2,U/**/T3 A3,U/**/T4 A4,         \
X                          U/**/T5 A5,U/**/T6 A6 H/**/T1(C1) H/**/T2(C2)        \
X                        H/**/T3(C3) H/**/T4(C4) H/**/T5(C5) H/**/T6(C6))       \
X{VCF(T1,1) VCF(T2,2) VCF(T3,3) VCF(T4,4) VCF(T5,5) VCF(T6,6) E/**/F            \
X G/**/F(NAME)CCF(T1,1),CCF(T2,2),CCF(T3,3),CCF(T4,4),CCF(T5,5),CCF(T6,6)       \
X JCF(T1,1) JCF(T2,2) JCF(T3,3) JCF(T4,4) JCF(T5,5) JCF(T6,6));                 \
X WCF(T1,1) WCF(T2,2) WCF(T3,3) WCF(T4,4) WCF(T5,5) WCF(T6,6) X/**/F}
X
X#define PROTOCCALLSFFUN7(F,NAME,T1,T2,T3,T4,T5,T6,T7)                          \
XU/**/F C_(NAME)();                                                             \
Xstatic U/**/F CFFUN(NAME)(U/**/T1 A1,U/**/T2 A2,U/**/T3 A3,U/**/T4 A4,         \
X                          U/**/T5 A5,U/**/T6 A6,U/**/T7 A7 H/**/T1(C1)         \
X  H/**/T2(C2) H/**/T3(C3) H/**/T4(C4) H/**/T5(C5) H/**/T6(C6) H/**/T7(C7))     \
X{VCF(T1,1) VCF(T2,2) VCF(T3,3) VCF(T4,4) VCF(T5,5) VCF(T6,6) VCF(T7,7) E/**/F  \
X G/**/F(NAME)CCF(T1,1),CCF(T2,2),CCF(T3,3),CCF(T4,4),CCF(T5,5),CCF(T6,6),      \
X             CCF(T7,7)                                                         \
X JCF(T1,1) JCF(T2,2) JCF(T3,3) JCF(T4,4) JCF(T5,5) JCF(T6,6) JCF(T7,7));       \
X WCF(T1,1) WCF(T2,2) WCF(T3,3) WCF(T4,4) WCF(T5,5) WCF(T6,6) WCF(T7,7) X/**/F}
X
X#define PROTOCCALLSFFUN8(F,NAME,T1,T2,T3,T4,T5,T6,T7,T8)                       \
XU/**/F C_(NAME)();                                                             \
Xstatic U/**/F CFFUN(NAME)(U/**/T1 A1,U/**/T2 A2,U/**/T3 A3,U/**/T4 A4,         \
X    U/**/T5 A5,U/**/T6 A6,U/**/T7 A7,U/**/T8 A8 H/**/T1(C1) H/**/T2(C2)        \
X  H/**/T3(C3) H/**/T4(C4) H/**/T5(C5) H/**/T6(C6) H/**/T7(C7) H/**/T8(C8))     \
X{VCF(T1,1) VCF(T2,2) VCF(T3,3) VCF(T4,4) VCF(T5,5) VCF(T6,6)VCF(T7,7) VCF(T8,8)\
X E/**/F  G/**/F(NAME)CCF(T1,1),CCF(T2,2),CCF(T3,3),CCF(T4,4),CCF(T5,5),        \
X                     CCF(T6,6),CCF(T7,7),CCF(T8,8)                             \
X JCF(T1,1) JCF(T2,2) JCF(T3,3) JCF(T4,4) JCF(T5,5) JCF(T6,6) JCF(T7,7)         \
X JCF(T8,8)); WCF(T1,1) WCF(T2,2) WCF(T3,3) WCF(T4,4) WCF(T5,5)                 \
X                       WCF(T6,6) WCF(T7,7) WCF(T8,8) X/**/F}
X
X#define PROTOCCALLSFFUN9(F,NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9)                    \
XU/**/F C_(NAME)();                                                             \
Xstatic U/**/F CFFUN(NAME)(U/**/T1 A1,U/**/T2 A2,U/**/T3 A3,U/**/T4 A4,         \
X    U/**/T5 A5,U/**/T6 A6,U/**/T7 A7,U/**/T8 A8,U/**/T9 A9                     \
X  H/**/T1(C1) H/**/T2(C2) H/**/T3(C3) H/**/T4(C4) H/**/T5(C5) H/**/T6(C6)      \
X  H/**/T7(C7) H/**/T8(C8) H/**/T9(C9))                                         \
X{VCF(T1,1) VCF(T2,2) VCF(T3,3) VCF(T4,4) VCF(T5,5) VCF(T6,6)VCF(T7,7) VCF(T8,8)\
X VCF(T9,9) E/**/F  G/**/F(NAME)CCF(T1,1),CCF(T2,2),CCF(T3,3),CCF(T4,4),        \
X                     CCF(T5,5),CCF(T6,6),CCF(T7,7),CCF(T8,8),CCF(T9,9)         \
X JCF(T1,1) JCF(T2,2) JCF(T3,3) JCF(T4,4) JCF(T5,5) JCF(T6,6) JCF(T7,7)         \
X JCF(T8,8) JCF(T9,9)); WCF(T1,1) WCF(T2,2) WCF(T3,3) WCF(T4,4) WCF(T5,5)       \
X                       WCF(T6,6) WCF(T7,7) WCF(T8,8) WCF(T9,9) X/**/F}
X
X/*-------------------------------------------------------------------------*/
X
X/*               UTILITIES FOR FORTRAN TO CALL C ROUTINES                  */
X
X#ifdef VAXC        /* To avoid %CC-I-PARAMNOTUSED. */
X#pragma nostandard
X#endif
X
X#define DDOUBLE(    A)
X#define DFLOAT(     A)
X#define DINT(       A)
X#define DLOGICAL(   A)
X#define DLONG(      A)
X#define DDOUBLEV(   A)
X#define DFLOATV(    A)
X#define DINTV(      A)
X#define DDOUBLEVV(  A)
X#define DFLOATVV(   A)
X#define DINTVV(     A)
X#define DPDOUBLE(   A)
X#define DPFLOAT(    A)
X#define DPINT(      A)
X#define DPLOGICAL(  A)
X#define DPLONG(     A)
X#define DPVOID(     A)
X#ifdef vms
X#define DSTRING(    A)
X#else
X#define DSTRING(    A) ,unsigned A
X#endif
X#define DSTRINGV       DSTRING
X#define DPSTRING       DSTRING
X#define DPSTRINGV      DSTRING
X
X#define QDOUBLE(    A)
X#define QFLOAT(     A)
X#define QINT(       A)
X#define QLOGICAL(   A)
X#define QLONG(      A)
X#define QDOUBLEV(   A)
X#define QFLOATV(    A)
X#define QINTV(      A)
X#define QDOUBLEVV(  A)
X#define QFLOATVV(   A)
X#define QINTVV(     A)
X#define QPDOUBLE(   A)
X#define QPFLOAT(    A)
X#define QPINT(      A)
X#define QPLOGICAL(  A)
X#define QPLONG(     A)
X#define QPVOID(     A)
X#ifdef vms
X#define QSTRINGV(   A) char *A;
X#else
X#define QSTRINGV(   A) char *A; unsigned int A/**/N;
X#endif
X#define QSTRING(    A) char *A;
X#define QPSTRING(   A) char *A;
X#define QPSTRINGV      QSTRINGV
X
X#define TCF(NAME,TN,I)     T/**/TN(NAME,A/**/I,B/**/I,D/**/I)
X#define TDOUBLE(  M,A,B,D) *A
X#define TFLOAT(   M,A,B,D) *A
X#define TINT(     M,A,B,D) *A
X#define TLOGICAL( M,A,B,D) *A
X#define TLONG(    M,A,B,D) *A
X#define TDOUBLEV( M,A,B,D)  A
X#define TFLOATV(  M,A,B,D)  A
X#define TINTV(    M,A,B,D)  A
X#define TDOUBLEVV(M,A,B,D)  A
X#define TFLOATVV( M,A,B,D)  A
X#define TINTVV(   M,A,B,D)  A
X#define TPDOUBLE( M,A,B,D)  A
X#define TPFLOAT(  M,A,B,D)  A
X#define TPINT(    M,A,B,D)  A
X#define TPLOGICAL(M,A,B,D)  A
X#define TPLONG(   M,A,B,D)  A
X#define TPVOID(   M,A,B,D)  A
X#ifdef vms
X#define TSTRING(  M,A,B,D)((B=malloc(A->dsc$w_length+1))[A->dsc$w_length]='\0',\
X kill_trailing(memcpy(B,A->dsc$a_pointer,A->dsc$w_length),' '))
X#define TSTRINGV( M,A,B,D)                                                     \
X (B=malloc((A->dsc$w_length+1)*A->dsc$l_m[0]), (void *)F2CSTRVCOPY(B,A))
X#else
X#define TSTRING(  M,A,B,D) (memcpy(B=malloc(D+1),A,D),B[D]='\0',               \
X                                                     kill_trailing(B,' '))
X#define TSTRINGV( M,A,B,D) (B/**/N=num_elem(A,D,M/**/_STRV_/**/A),             \
X     (void *)vkill_trailing(f2cstrv(A,B=malloc(B/**/N*(D+1)),D+1,B/**/N*(D+1)),\
X                            D+1,B/**/N*(D+1),' '))
X#endif
X#define TPSTRING            TSTRING
X#define TPSTRINGV           TSTRINGV
X
X#define RCF(TN,I)           R/**/TN(A/**/I,B/**/I,D/**/I)
X#define RDOUBLE(  A,B,D)
X#define RFLOAT(   A,B,D)
X#define RINT(     A,B,D)
X#define RLOGICAL( A,B,D)
X#define RLONG(    A,B,D)
X#define RDOUBLEV( A,B,D)
X#define RFLOATV(  A,B,D)
X#define RINTV(    A,B,D)
X#define RDOUBLEVV(A,B,D)
X#define RFLOATVV( A,B,D)
X#define RINTVV(   A,B,D)
X#define RPDOUBLE( A,B,D)
X#define RPFLOAT(  A,B,D)
X#define RPINT(    A,B,D)
X#define RPLOGICAL(A,B,D)
X#define RPLONG(   A,B,D)
X#define RPVOID(   A,B,D)
X#define RSTRING(  A,B,D)    free(B);
X#define RSTRINGV( A,B,D)    free(B);
X#ifdef vms
X#define RPSTRING( A,B,D)                                                       \
X memcpy(A->dsc$a_pointer,B,MIN(strlen(B),A->dsc$w_length)),                    \
X (A->dsc$w_length>strlen(B)?                                                   \
X   memset(A->dsc$a_pointer+strlen(B),' ', A->dsc$w_length-strlen(B)):0),free(B);
X#define RPSTRINGV(A,B,D) C2FSTRVCOPY(B,A), free(B);
X#else
X#define RPSTRING( A,B,D)   memcpy(A,B,MIN(strlen(B),D)),                       \
X                  (D>strlen(B)?memset(A+strlen(B),' ', D-strlen(B)):0), free(B);
X#define RPSTRINGV(A,B,D) c2fstrv(B,A,D+1,(D+1)*B/**/N), free(B);
X#endif
X
X#define FZDOUBLE(   A) double  fcallsc(A)(
X#define FZFLOAT(    A) float   fcallsc(A)(
X#define FZINT(      A) int     fcallsc(A)(
X#define FZLOGICAL(  A) int     fcallsc(A)(
X#define FZLONG(     A) long    fcallsc(A)(
X#define FZVOID(     A) void    fcallsc(A)(
X#ifdef vms
X#define FZSTRING(   A) void    fcallsc(A)(fstring *AS
X#else
X#define FZSTRING(   A) void    fcallsc(A)(char *AS, unsigned D0
X#endif
X
X#define FDOUBLE(    A) double  fcallsc(A)(
X#define FFLOAT(     A) float   fcallsc(A)(
X#define FINT(       A) int     fcallsc(A)(
X#define FLOGICAL(   A) int     fcallsc(A)(
X#define FLONG(      A) long    fcallsc(A)(
X#define FVOID(      A) void    fcallsc(A)(
X#define FSTRING(    A) FZSTRING(A),
X
X#define LDOUBLE( NAME) A0=ccallsc(NAME)
X#define LFLOAT(  NAME) A0=ccallsc(NAME)
X#define LINT(    NAME) A0=ccallsc(NAME)
X#define LLOGICAL(NAME) A0=ccallsc(NAME)
X#define LLONG(   NAME) A0=ccallsc(NAME)
X#define LSTRING( NAME) A0=ccallsc(NAME)
X#define LVOID(   NAME)    ccallsc(NAME)
X
X#define KDOUBLE
X#define KFLOAT
X#define KINT
X#define KLOGICAL
X#define KLONG
X#define KVOID
X/* KSTRING copies the string into the position provided by the caller. */
X#ifdef vms
X#define KSTRING                                                                \
X memcpy(AS->dsc$a_pointer,A0, MIN(AS->dsc$w_length,(A0==NULL?0:strlen(A0))) ); \
X AS->dsc$w_length>(A0==NULL?0:strlen(A0))?                                     \
X  memset(AS->dsc$a_pointer+(A0==NULL?0:strlen(A0)),' ',                        \
X         AS->dsc$w_length-(A0==NULL?0:strlen(A0))):0;
X#else
X#define KSTRING  memcpy(AS,A0, MIN(D0,(A0==NULL?0:strlen(A0))) );              \
X                 D0>(A0==NULL?0:strlen(A0))?memset(AS+(A0==NULL?0:strlen(A0)), \
X                                            ' ', D0-(A0==NULL?0:strlen(A0))):0;
X#endif
X
X/* Note that K.. and I.. can't be combined since K.. has to access data before
XR.., in order for functions returning strings which are also passed in as
Xarguments to work correctly. Note that R.. frees and hence may corrupt the
Xstring. */
X#define IDOUBLE        return  A0;
X#define IFLOAT         return  A0;
X#define IINT           return  A0;
X#define ILOGICAL       return  A0;
X#define ILONG          return  A0;
X#define ISTRING        return    ;
X#define IVOID          return    ;
X
X#ifdef VAXC        /* Have avoided %CC-I-PARAMNOTUSED. */
X#pragma standard
X#endif
X
X#define FCALLSCSUB0(NAME)                FCALLSCFUN0(VOID,NAME)
X#define FCALLSCSUB1(NAME,T1)             FCALLSCFUN1(VOID,NAME,T1)
X#define FCALLSCSUB2(NAME,T1,T2)          FCALLSCFUN2(VOID,NAME,T1,T2)
X#define FCALLSCSUB3(NAME,T1,T2,T3)       FCALLSCFUN3(VOID,NAME,T1,T2,T3)
X#define FCALLSCSUB4(NAME,T1,T2,T3,T4)    FCALLSCFUN4(VOID,NAME,T1,T2,T3,T4)
X#define FCALLSCSUB5(NAME,T1,T2,T3,T4,T5) FCALLSCFUN5(VOID,NAME,T1,T2,T3,T4,T5)
X#define FCALLSCSUB6(NAME,T1,T2,T3,T4,T5,T6)                                    \
X                               FCALLSCFUN6(VOID,NAME,T1,T2,T3,T4,T5,T6)
X#define FCALLSCSUB7(NAME,T1,T2,T3,T4,T5,T6,T7)                                 \
X                               FCALLSCFUN7(VOID,NAME,T1,T2,T3,T4,T5,T6,T7)
X#define FCALLSCSUB8(NAME,T1,T2,T3,T4,T5,T6,T7,T8)                              \
X                               FCALLSCFUN8(VOID,NAME,T1,T2,T3,T4,T5,T6,T7,T8)
X#define FCALLSCSUB9(NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9)                           \
X                               FCALLSCFUN9(VOID,NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9)
X
X#define FCALLSCFUN0(T0,NAME)                                                   \
XFZ/**/T0(NAME)) {U/**/T0 A0; L/**/T0(NAME)(); K/**/T0 I/**/T0}
X
X#define FCALLSCFUN1(T0,NAME,T1)                                                \
XF/**/T0(NAME)N/**/T1 A1 D/**/T1(D1)) {U/**/T0 A0; Q/**/T1(B1)                  \
X L/**/T0(NAME)(TCF(NAME,T1,1)); K/**/T0 RCF(T1,1) I/**/T0}
X
X#define FCALLSCFUN2(T0,NAME,T1,T2)                                             \
XF/**/T0(NAME)N/**/T1 A1,N/**/T2 A2 D/**/T1(D1) D/**/T2(D2))                    \
X{U/**/T0 A0; Q/**/T1(B1) Q/**/T2(B2)                                           \
X L/**/T0(NAME)(TCF(NAME,T1,1),TCF(NAME,T2,2));K/**/T0 RCF(T1,1)RCF(T2,2)I/**/T0}
X
X#define FCALLSCFUN3(T0,NAME,T1,T2,T3)                                          \
XF/**/T0(NAME)N/**/T1 A1,N/**/T2 A2,N/**/T3 A3 D/**/T1(D1) D/**/T2(D2)          \
X D/**/T3(D3)) {U/**/T0 A0; Q/**/T1(B1) Q/**/T2(B2) Q/**/T3(B3)                 \
X L/**/T0(NAME)(TCF(NAME,T1,1),TCF(NAME,T2,2),TCF(NAME,T3,3));                  \
X K/**/T0 RCF(T1,1) RCF(T2,2) RCF(T3,3) I/**/T0}
X
X#define FCALLSCFUN4(T0,NAME,T1,T2,T3,T4)                                       \
XF/**/T0(NAME)N/**/T1 A1,N/**/T2 A2,N/**/T3 A3,N/**/T4 A4 D/**/T1(D1)           \
X D/**/T2(D2) D/**/T3(D3) D/**/T4(D4)) {U/**/T0 A0; Q/**/T1(B1) Q/**/T2(B2)     \
X Q/**/T3(B3) Q/**/T4(B4) L/**/T0(NAME)(TCF(NAME,T1,1),TCF(NAME,T2,2),          \
X TCF(NAME,T3,3),TCF(NAME,T4,4)); K/**/T0 RCF(T1,1)RCF(T2,2) RCF(T3,3) RCF(T4,4)\
X I/**/T0}
X
X#define FCALLSCFUN5(T0,NAME,T1,T2,T3,T4,T5)                                    \
XF/**/T0(NAME)N/**/T1 A1,N/**/T2 A2,N/**/T3 A3,N/**/T4 A4,N/**/T5 A5            \
X D/**/T1(D1) D/**/T2(D2) D/**/T3(D3) D/**/T4(D4) D/**/T5(D5)) {U/**/T0 A0;     \
X Q/**/T1(B1) Q/**/T2(B2) Q/**/T3(B3) Q/**/T4(B4) Q/**/T5(B5)                   \
X L/**/T0(NAME)(TCF(NAME,T1,1),TCF(NAME,T2,2),TCF(NAME,T3,3),TCF(NAME,T4,4),    \
X TCF(NAME,T5,5)); K/**/T0 RCF(T1,1)RCF(T2,2)RCF(T3,3)RCF(T4,4)RCF(T5,5) I/**/T0}
X
X#define FCALLSCFUN6(T0,NAME,T1,T2,T3,T4,T5,T6)                                 \
XF/**/T0(NAME)N/**/T1 A1,N/**/T2 A2,N/**/T3 A3,N/**/T4 A4,N/**/T5 A5,           \
X N/**/T6 A6 D/**/T1(D1) D/**/T2(D2) D/**/T3(D3) D/**/T4(D4) D/**/T5(D5)        \
X D/**/T6(D6)) {U/**/T0 A0; Q/**/T1(B1) Q/**/T2(B2) Q/**/T3(B3) Q/**/T4(B4)     \
X Q/**/T5(B5) Q/**/T6(B6) L/**/T0(NAME)(TCF(NAME,T1,1),TCF(NAME,T2,2),          \
X TCF(NAME,T3,3),TCF(NAME,T4,4),TCF(NAME,T5,5),TCF(NAME,T6,6)); K/**/T0         \
X RCF(T1,1) RCF(T2,2) RCF(T3,3) RCF(T4,4) RCF(T5,5) RCF(T6,6) I/**/T0}
X
X#define FCALLSCFUN7(T0,NAME,T1,T2,T3,T4,T5,T6,T7)                              \
XF/**/T0(NAME)N/**/T1 A1,N/**/T2 A2,N/**/T3 A3,N/**/T4 A4,N/**/T5 A5,           \
X N/**/T6 A6 N/**/T7 A7 D/**/T1(D1) D/**/T2(D2) D/**/T3(D3) D/**/T4(D4)         \
X D/**/T5(D5) D/**/T6(D6) D/**/T7(D7)) {U/**/T0 A0; Q/**/T1(B1) Q/**/T2(B2)     \
X Q/**/T3(B3) Q/**/T4(B4) Q/**/T5(B5) Q/**/T6(B6) Q/**/T7(B7)                   \
X L/**/T0(NAME)(TCF(NAME,T1,1),TCF(NAME,T2,2),TCF(NAME,T3,3),TCF(NAME,T4,4),    \
X TCF(NAME,T5,5),TCF(NAME,T6,6),TCF(NAME,T7,7)); K/**/T0                        \
X RCF(T1,1) RCF(T2,2) RCF(T3,3) RCF(T4,4) RCF(T5,5) RCF(T6,6) RCF(T7,7) I/**/T0}
X
X#define FCALLSCFUN8(T0,NAME,T1,T2,T3,T4,T5,T6,T7,T8)                           \
XF/**/T0(NAME)N/**/T1 A1,N/**/T2 A2,N/**/T3 A3,N/**/T4 A4,N/**/T5 A5,           \
X N/**/T6 A6 N/**/T7 A7 N/**/T8 A8 D/**/T1(D1) D/**/T2(D2) D/**/T3(D3)          \
X D/**/T4(D4) D/**/T5(D5) D/**/T6(D6) D/**/T7(D7) D/**/T8(D8)) {U/**/T0 A0;     \
X Q/**/T1(B1) Q/**/T2(B2) Q/**/T3(B3) Q/**/T4(B4) Q/**/T5(B5) Q/**/T6(B6)       \
X Q/**/T7(B7) Q/**/T8(B8) L/**/T0(NAME)(TCF(NAME,T1,1),TCF(NAME,T2,2),          \
X TCF(NAME,T3,3),TCF(NAME,T4,4),TCF(NAME,T5,5),TCF(NAME,T6,6),TCF(NAME,T7,7),   \
X TCF(NAME,T8,8)); K/**/T0 RCF(T1,1) RCF(T2,2) RCF(T3,3) RCF(T4,4) RCF(T5,5)    \
X RCF(T6,6) RCF(T7,7) RCF(T8,8) I/**/T0}
X
X#define FCALLSCFUN9(T0,NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9)                        \
XF/**/T0(NAME)N/**/T1 A1,N/**/T2 A2,N/**/T3 A3,N/**/T4 A4,N/**/T5 A5,           \
X N/**/T6 A6 N/**/T7 A7 N/**/T8 A8 N/**/T9 A9 D/**/T1(D1) D/**/T2(D2)           \
X D/**/T3(D3) D/**/T4(D4) D/**/T5(D5) D/**/T6(D6) D/**/T7(D7) D/**/T8(D8)       \
X D/**/T8(D8) D/**/T9(D9)) {U/**/T0 A0; Q/**/T1(B1) Q/**/T2(B2) Q/**/T3(B3)     \
X Q/**/T4(B4) Q/**/T5(B5) Q/**/T6(B6) Q/**/T7(B7) Q/**/T8(B8) Q/**/T9(B9)       \
X L/**/T0(NAME)(TCF(NAME,T1,1),TCF(NAME,T2,2),TCF(NAME,T3,3),TCF(NAME,T4,4),    \
X TCF(NAME,T5,5),TCF(NAME,T6,6),TCF(NAME,T7,7),TCF(NAME,T8,8),TCF(NAME,T9,9));  \
X K/**/T0 RCF(T1,1) RCF(T2,2) RCF(T3,3) RCF(T4,4) RCF(T5,5)                     \
X RCF(T6,6) RCF(T7,7) RCF(T8,8) RCF(T9,9) I/**/T0}
X
X
X#endif                                  /* __CFORTRAN_LOADED */
X#endif                                  /* This is VMS, Mips or IBMR2.      */
END_OF_FILE
  if test 54924 -ne `wc -c <'cfortran.h'`; then
    echo shar: \"'cfortran.h'\" unpacked with wrong size!
  fi
  # end of 'cfortran.h'
fi
echo shar: End of archive 2 \(of 2\).
cp /dev/null ark2isdone
MISSING=""
for I in 1 2 ; do
    if test ! -f ark${I}isdone ; then
	MISSING="${MISSING} ${I}"
    fi
done
if test "${MISSING}" = "" ; then
    echo You have unpacked both archives.
    rm -f ark[1-9]isdone
else
    echo You still must unpack the following archives:
    echo "        " ${MISSING}
fi
exit 0
exit 0 # Just in case...
-- 
Kent Landfield                   INTERNET: kent@sparky.IMD.Sterling.COM
Sterling Software, IMD           UUCP:     uunet!sparky!kent
Phone:    (402) 291-8300         FAX:      (402) 291-4362
Please send comp.sources.misc-related mail to kent@uunet.uu.net.