cfortran.h

Go to the documentation of this file.
00001                                                                                                                                         /* cfortran.h  3.9 *//* anonymous ftp@zebra.desy.de */
00002 /* Burkhard Burow  burow@desy.de                 1990 - 1997. */
00003 
00004 #ifndef __CFORTRAN_LOADED
00005 #define __CFORTRAN_LOADED
00006 
00007 /* 
00008    THIS FILE IS PROPERTY OF BURKHARD BUROW. IF YOU ARE USING THIS FILE YOU
00009    SHOULD ALSO HAVE ACCESS TO CFORTRAN.DOC WHICH PROVIDES TERMS FOR USING,
00010    MODIFYING, COPYING AND DISTRIBUTING THE CFORTRAN.H PACKAGE.
00011 */
00012 
00013 /* 
00014   Avoid symbols already used by compilers and system *.h:
00015   __ - OSF1 zukal06 V3.0 347 alpha, cc -c -std1 cfortest.c
00016 
00017  */
00018 
00019 
00020 /* First prepare for the C compiler. */
00021 
00022 #ifndef ANSI_C_preprocessor     /* i.e. user can override. */
00023 #ifdef __CF__KnR
00024 #define ANSI_C_preprocessor 0
00025 #else
00026 #ifdef __STDC__
00027 #define ANSI_C_preprocessor 1
00028 #else
00029 #define _cfleft             1
00030 #define _cfright
00031 #define _cfleft_cfright     0
00032 #define ANSI_C_preprocessor _cfleft/**/_cfright
00033 #endif
00034 #endif
00035 #endif
00036 
00037 #if ANSI_C_preprocessor
00038 #define _0(A,B)   A##B
00039 #define  _(A,B)   _0(A,B)       /* see cat,xcat of K&R ANSI C p. 231 */
00040 #define _2(A,B)   A##B          /* K&R ANSI C p.230: .. identifier is not replaced */
00041 #define _3(A,B,C) _(A,_(B,C))
00042 #else                           /* if it turns up again during rescanning.         */
00043 #define  _(A,B)   A/**/B
00044 #define _2(A,B)   A/**/B
00045 #define _3(A,B,C) A/**/B/**/C
00046 #endif
00047 
00048 #if (defined(vax)&&defined(unix)) || (defined(__vax__)&&defined(__unix__))
00049 #define VAXUltrix
00050 #endif
00051 
00052 #include <stdio.h>              /* NULL [in all machines stdio.h]                      */
00053 #include <string.h>             /* strlen, memset, memcpy, memchr.                     */
00054 #if !( defined(VAXUltrix) || defined(sun) || (defined(apollo)&&!defined(__STDCPP__)) )
00055 #include <stdlib.h>             /* malloc,free                                         */
00056 #else
00057 #include <malloc.h>             /* Had to be removed for DomainOS h105 10.4 sys5.3 425t */
00058 #ifdef apollo
00059 #define __CF__APOLLO67          /* __STDCPP__ is in Apollo 6.8 (i.e. ANSI) and onwards */
00060 #endif
00061 #endif
00062 
00063 #if !defined(__GNUC__) && !defined(__sun) && (defined(sun)||defined(VAXUltrix)||defined(lynx))
00064 #define __CF__KnR               /* Sun, LynxOS and VAX Ultrix cc only supports K&R.     */
00065                       /* Manually define __CF__KnR for HP if desired/required. */
00066 #endif                          /*       i.e. We will generate Kernighan and Ritchie C. */
00067 /* Note that you may define __CF__KnR before #include cfortran.h, in order to
00068 generate K&R C instead of the default ANSI C. The differences are mainly in the
00069 function prototypes and declarations. All machines, except the Apollo, work
00070 with either style. The Apollo's argument promotion rules require ANSI or use of
00071 the obsolete std_$call which we have not implemented here. Hence on the Apollo,
00072 only C calling FORTRAN subroutines will work using K&R style.*/
00073 
00074 
00075 /* Remainder of cfortran.h depends on the Fortran compiler. */
00076 
00077 #ifdef CLIPPERFortran
00078 #define f2cFortran
00079 #endif
00080 
00081 /* VAX/VMS does not let us \-split long #if lines. */
00082 /* Split #if into 2 because some HP-UX can't handle long #if */
00083 #if !(defined(NAGf90Fortran)||defined(f2cFortran)||defined(hpuxFortran)||defined(apolloFortran)||defined(sunFortran)||defined(IBMR2Fortran)||defined(CRAYFortran))
00084 #if !(defined(mipsFortran)||defined(DECFortran)||defined(vmsFortran)||defined(CONVEXFortran)||defined(PowerStationFortran)||defined(AbsoftUNIXFortran)||defined(SXFortran))
00085 /* If no Fortran compiler is given, we choose one for the machines we know.   */
00086 #if defined(lynx) || defined(VAXUltrix)
00087 #define f2cFortran              /* Lynx:      Only support f2c at the moment.
00088                                    VAXUltrix: f77 behaves like f2c.
00089                                    Support f2c or f77 with gcc, vcc with f2c. 
00090                                    f77 with vcc works, missing link magic for f77 I/O. */
00091 #endif
00092 #if defined(__hpux)             /* 921107: Use __hpux instead of __hp9000s300 */
00093 #define       hpuxFortran       /*         Should also allow hp9000s7/800 use. */
00094 #endif
00095 #if       defined(apollo)
00096 #define           apolloFortran /* __CF__APOLLO67 also defines some behavior. */
00097 #endif
00098 #if          defined(sun) || defined(__sun)
00099 #define              sunFortran
00100 #endif
00101 #if       defined(_IBMR2)
00102 #define            IBMR2Fortran
00103 #endif
00104 #if        defined(_CRAY)
00105 #define             CRAYFortran /*       _CRAYT3E also defines some behavior. */
00106 #endif
00107 #if        defined(_SX)
00108 #define               SXFortran
00109 #endif
00110 #if         defined(mips) || defined(__mips)
00111 #define             mipsFortran
00112 #endif
00113 #if          defined(vms) || defined(__vms)
00114 #define              vmsFortran
00115 #endif
00116 #if      defined(__alpha) && defined(__unix__)
00117 #define              DECFortran
00118 #endif
00119 #if   defined(__convex__)
00120 #define           CONVEXFortran
00121 #endif
00122 #if   defined(VISUAL_CPLUSPLUS)
00123 #define     PowerStationFortran
00124 #endif
00125 #endif                          /* ...Fortran */
00126 #endif                          /* ...Fortran */
00127 
00128 /* Split #if into 2 because some HP-UX can't handle long #if */
00129 #if !(defined(NAGf90Fortran)||defined(f2cFortran)||defined(hpuxFortran)||defined(apolloFortran)||defined(sunFortran)||defined(IBMR2Fortran)||defined(CRAYFortran))
00130 #if !(defined(mipsFortran)||defined(DECFortran)||defined(vmsFortran)||defined(CONVEXFortran)||defined(PowerStationFortran)||defined(AbsoftUNIXFortran)||defined(SXFortran))
00131 /* If your compiler barfs on ' #error', replace # with the trigraph for #     */
00132 #error "cfortran.h:  Can't find your environment among:\
00133     - MIPS cc and f77 2.0. (e.g. Silicon Graphics, DECstations, ...)     \
00134     - IBM AIX XL C and FORTRAN Compiler/6000 Version 01.01.0000.0000     \
00135     - VAX   VMS CC 3.1 and FORTRAN 5.4.                                  \
00136     - Alpha VMS DEC C 1.3 and DEC FORTRAN 6.0.                           \
00137     - Alpha OSF DEC C and DEC Fortran for OSF/1 AXP Version 1.2          \
00138     - Apollo DomainOS 10.2 (sys5.3) with f77 10.7 and cc 6.7.            \
00139     - CRAY                                                               \
00140     - NEC SX-4 SUPER-UX                                                  \
00141     - CONVEX                                                             \
00142     - Sun                                                                \
00143     - PowerStation Fortran with Visual C++                               \
00144     - HP9000s300/s700/s800 Latest test with: HP-UX A.08.07 A 9000/730    \
00145     - LynxOS: cc or gcc with f2c.                                        \
00146     - VAXUltrix: vcc,cc or gcc with f2c. gcc or cc with f77.             \
00147     -            f77 with vcc works; but missing link magic for f77 I/O. \
00148     -            NO fort. None of gcc, cc or vcc generate required names.\
00149     - f2c    : Use #define    f2cFortran, or cc -Df2cFortran             \
00150     - NAG f90: Use #define NAGf90Fortran, or cc -DNAGf90Fortran          \
00151     - Absoft UNIX F77: Use #define AbsoftUNIXFortran or cc -DAbsoftUNIXFortran"
00152 /* Compiler must throw us out at this point! */
00153 #endif
00154 #endif
00155 
00156 
00157 #if defined(VAXC) && !defined(__VAXC)
00158 #define OLD_VAXC
00159 #pragma nostandard              /* Prevent %CC-I-PARAMNOTUSED.       */
00160 #endif
00161 
00162 /* Throughout cfortran.h we use: UN = Uppercase Name.  LN = Lowercase Name.   */
00163 
00164 #if defined(f2cFortran) || defined(NAGf90Fortran) || defined(DECFortran) || defined(mipsFortran) || defined(apolloFortran) || defined(sunFortran) || defined(CONVEXFortran) || defined(SXFortran) || defined(extname)
00165 #define CFC_(UN,LN)            _(LN,_)  /* Lowercase FORTRAN symbols.     */
00166 #define orig_fcallsc(UN,LN)    CFC_(UN,LN)
00167 #else
00168 #if defined(CRAYFortran) || defined(PowerStationFortran)
00169 #ifdef _CRAY                    /* (UN), not UN, circumvents CRAY preprocessor bug.     */
00170 #define CFC_(UN,LN)            (UN)     /* Uppercase FORTRAN symbols.     */
00171 #else                           /* At least VISUAL_CPLUSPLUS barfs on (UN), so need UN. */
00172 #define CFC_(UN,LN)            UN       /* Uppercase FORTRAN symbols.     */
00173 #endif
00174 #define orig_fcallsc(UN,LN)    CFC_(UN,LN)      /* CRAY insists on arg.'s here.   */
00175 #else                           /* For following machines one may wish to change the fcallsc default.  */
00176 #define CF_SAME_NAMESPACE
00177 #ifdef vmsFortran
00178 #define CFC_(UN,LN)            LN       /* Either case FORTRAN symbols.   */
00179      /* BUT we usually use UN for C macro to FORTRAN routines, so use LN here, */
00180      /* because VAX/VMS doesn't do recursive macros.                          */
00181 #define orig_fcallsc(UN,LN)    UN
00182 #else                           /* HP-UX without +ppu or IBMR2 without -qextname. NOT reccomended. */
00183 #define CFC_(UN,LN)            LN       /* Lowercase FORTRAN symbols.     */
00184 #define orig_fcallsc(UN,LN)    CFC_(UN,LN)
00185 #endif                          /*  vmsFortran */
00186 #endif                          /* CRAYFortran PowerStationFortran */
00187 #endif                          /* ....Fortran */
00188 
00189 #define fcallsc(UN,LN)               orig_fcallsc(UN,LN)
00190 #define preface_fcallsc(P,p,UN,LN)   CFC_(_(P,UN),_(p,LN))
00191 #define  append_fcallsc(P,p,UN,LN)   CFC_(_(UN,P),_(LN,p))
00192 
00193 #define C_FUNCTION(UN,LN)            fcallsc(UN,LN)
00194 #define FORTRAN_FUNCTION(UN,LN)      CFC_(UN,LN)
00195 
00196 #ifndef COMMON_BLOCK
00197 #ifndef CONVEXFortran
00198 #ifndef CLIPPERFortran
00199 #ifndef AbsoftUNIXFortran
00200 #define COMMON_BLOCK(UN,LN)          CFC_(UN,LN)
00201 #else
00202 #define COMMON_BLOCK(UN,LN)          _(_C,LN)
00203 #endif
00204 #else
00205 #define COMMON_BLOCK(UN,LN)          _(LN,__)
00206 #endif
00207 #else
00208 #define COMMON_BLOCK(UN,LN)          _3(_,LN,_)
00209 #endif
00210 #endif
00211 
00212 #ifndef DOUBLE_PRECISION
00213 #if defined(CRAYFortran) && !defined(_CRAYT3E)
00214 #define DOUBLE_PRECISION long double
00215 #else
00216 #define DOUBLE_PRECISION double
00217 #endif
00218 #endif
00219 
00220 #ifndef FORTRAN_REAL
00221 #if defined(CRAYFortran) &&  defined(_CRAYT3E)
00222 #define FORTRAN_REAL double
00223 #else
00224 #define FORTRAN_REAL float
00225 #endif
00226 #endif
00227 
00228 #ifdef CRAYFortran
00229 #ifdef _CRAY
00230 #include <fortran.h>
00231 #else
00232 #include "fortran.h"            /* i.e. if crosscompiling assume user has file. */
00233 #endif
00234 #define FLOATVVVVVVV_cfPP (FORTRAN_REAL *)      /* Used for C calls FORTRAN.     */
00235 /* CRAY's double==float but CRAY says pointers to doubles and floats are diff.*/
00236 #define VOIDP  (void *)         /* When FORTRAN calls C, we don't know if C routine 
00237                                    arg.'s have been declared float *, or double *.   */
00238 #else
00239 #define FLOATVVVVVVV_cfPP
00240 #define VOIDP
00241 #endif
00242 
00243 #ifdef vmsFortran
00244 #if    defined(vms) || defined(__vms)
00245 #include <descrip.h>
00246 #else
00247 #include "descrip.h"            /* i.e. if crosscompiling assume user has file. */
00248 #endif
00249 #endif
00250 
00251 #ifdef sunFortran
00252 #if defined(sun) || defined(__sun)
00253 #include <math.h>               /* Sun's FLOATFUNCTIONTYPE, ASSIGNFLOAT, RETURNFLOAT.  */
00254 #else
00255 #include "math.h"               /* i.e. if crosscompiling assume user has file. */
00256 #endif
00257 /* At least starting with the default C compiler SC3.0.1 of SunOS 5.3,
00258  * FLOATFUNCTIONTYPE, ASSIGNFLOAT, RETURNFLOAT are not required and not in
00259  * <math.h>, since sun C no longer promotes C float return values to doubles.
00260  * Therefore, only use them if defined.
00261  * Even if gcc is being used, assume that it exhibits the Sun C compiler
00262  * behavior in order to be able to use *.o from the Sun C compiler.
00263  * i.e. If FLOATFUNCTIONTYPE, etc. are in math.h, they required by gcc.
00264  */
00265 #endif
00266 
00267 #ifndef apolloFortran
00268 #define COMMON_BLOCK_DEF(DEFINITION, NAME) extern DEFINITION NAME
00269 #define CF_NULL_PROTO
00270 #else                           /* HP doesn't understand #elif. */
00271 /* Without ANSI prototyping, Apollo promotes float functions to double.    */
00272 /* Note that VAX/VMS, IBM, Mips choke on 'type function(...);' prototypes. */
00273 #define CF_NULL_PROTO ...
00274 #ifndef __CF__APOLLO67
00275 #define COMMON_BLOCK_DEF(DEFINITION, NAME) \
00276  DEFINITION NAME __attribute((__section(NAME)))
00277 #else
00278 #define COMMON_BLOCK_DEF(DEFINITION, NAME) \
00279  DEFINITION NAME #attribute[section(NAME)]
00280 #endif
00281 #endif
00282 
00283 #ifdef __cplusplus
00284 #undef  CF_NULL_PROTO
00285 #define CF_NULL_PROTO  ...
00286 #endif
00287 
00288 #ifdef mipsFortran
00289 #define CF_DECLARE_GETARG         int f77argc; char **f77argv
00290 #define CF_SET_GETARG(ARGC,ARGV)  f77argc = ARGC; f77argv = ARGV
00291 #else
00292 #define CF_DECLARE_GETARG
00293 #define CF_SET_GETARG(ARGC,ARGV)
00294 #endif
00295 
00296 #ifdef OLD_VAXC                 /* Allow %CC-I-PARAMNOTUSED.         */
00297 #pragma standard
00298 #endif
00299 
00300 #define ACOMMA ,
00301 #define ACOLON ;
00302 
00303 /*-------------------------------------------------------------------------*/
00304 
00305 /*               UTILITIES USED WITHIN CFORTRAN.H                          */
00306 
00307 #define _cfMIN(A,B) (A<B?A:B)
00308 #ifndef FALSE
00309 #define FALSE (1==0)
00310 #endif
00311 
00312 /* 970211 - XIX.145:
00313    firstindexlength  - better name is all_but_last_index_lengths
00314    secondindexlength - better name is         last_index_length
00315  */
00316 #define  firstindexlength(A) (sizeof(A[0])==1 ? 1 : (sizeof(A) / sizeof(A[0])) )
00317 #define secondindexlength(A) (sizeof(A[0])==1 ?      sizeof(A) : sizeof(A[0])  )
00318 
00319 /* Behavior of FORTRAN LOGICAL. All machines' LOGICAL is same size as C's int.
00320 Conversion is automatic except for arrays which require F2CLOGICALV/C2FLOGICALV.
00321 f2c, MIPS f77 [DECstation, SGI], VAX Ultrix f77,
00322 HP-UX f77                                        : as in C.
00323 VAX/VMS FORTRAN, VAX Ultrix fort,
00324 Absoft Unix Fortran, IBM RS/6000 xlf             : LS Bit = 0/1 = TRUE/FALSE.
00325 Apollo                                           : neg.   = TRUE, else FALSE. 
00326 [Apollo accepts -1 as TRUE for function values, but NOT all other neg. values.]
00327 [DECFortran for Ultrix RISC is also called f77 but is the same as VAX/VMS.]   
00328 [MIPS f77 treats .eqv./.neqv. as .eq./.ne. and hence requires LOGICAL_STRICT.]*/
00329 
00330 #if defined(NAGf90Fortran) || defined(f2cFortran) || defined(mipsFortran) || defined(PowerStationFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran) || defined(SXFortran)
00331 /* SX/PowerStationFortran have 0 and 1 defined, others are neither T nor F.   */
00332 /* hpuxFortran800 has 0 and 0x01000000 defined. Others are unknown.           */
00333 #define LOGICAL_STRICT          /* Other Fortran have .eqv./.neqv. == .eq./.ne.   */
00334 #endif
00335 
00336 #define C2FLOGICALV(A,I) \
00337  do {int __i; for(__i=0;__i<I;__i++) A[__i]=C2FLOGICAL(A[__i]); } while (FALSE)
00338 #define F2CLOGICALV(A,I) \
00339  do {int __i; for(__i=0;__i<I;__i++) A[__i]=F2CLOGICAL(A[__i]); } while (FALSE)
00340 
00341 #if defined(apolloFortran)
00342 #define C2FLOGICAL(L) ((L)?-1:(L)&~((unsigned)1<<sizeof(int)*8-1))
00343 #define F2CLOGICAL(L) ((L)<0?(L):0)
00344 #else
00345 #if defined(CRAYFortran)
00346 #define C2FLOGICAL(L) _btol(L)
00347 #define F2CLOGICAL(L) _ltob(&(L))       /* Strangely _ltob() expects a pointer. */
00348 #else
00349 #if defined(IBMR2Fortran) || defined(vmsFortran) || defined(DECFortran) || defined(AbsoftUNIXFortran)
00350 #define C2FLOGICAL(L) ((L)?(L)|1:(L)&~(int)1)
00351 #define F2CLOGICAL(L) ((L)&1?(L):0)
00352 #else
00353 #if defined(CONVEXFortran)
00354 #define C2FLOGICAL(L) ((L) ? ~0 : 0 )
00355 #define F2CLOGICAL(L) (L)
00356 #else                           /* others evaluate LOGICALs as for C. */
00357 #define C2FLOGICAL(L) (L)
00358 #define F2CLOGICAL(L) (L)
00359 #ifndef LOGICAL_STRICT
00360 #undef  C2FLOGICALV
00361 #undef  F2CLOGICALV
00362 #define C2FLOGICALV(A,I)
00363 #define F2CLOGICALV(A,I)
00364 #endif                          /* LOGICAL_STRICT                     */
00365 #endif                          /* CONVEXFortran || All Others        */
00366 #endif                          /* IBMR2Fortran vmsFortran DECFortran AbsoftUNIXFortran */
00367 #endif                          /* CRAYFortran                        */
00368 #endif                          /* apolloFortran                      */
00369 
00370 /* 970514 - In addition to CRAY, there may be other machines
00371             for which LOGICAL_STRICT makes no sense. */
00372 #if defined(LOGICAL_STRICT) && !defined(CRAYFortran)
00373 /* Force C2FLOGICAL to generate only the values for either .TRUE. or .FALSE.
00374    SX/PowerStationFortran only have 0 and 1 defined.
00375    Elsewhere, only needed if you want to do:
00376      logical lvariable
00377      if (lvariable .eq.  .true.) then       ! (1)
00378    instead of
00379      if (lvariable .eqv. .true.) then       ! (2)
00380    - (1) may not even be FORTRAN/77 and that Apollo's f77 and IBM's xlf
00381      refuse to compile (1), so you are probably well advised to stay away from 
00382      (1) and from LOGICAL_STRICT.
00383    - You pay a (slight) performance penalty for using LOGICAL_STRICT. */
00384 #undef  C2FLOGICAL
00385 #ifdef hpuxFortran800
00386 #define C2FLOGICAL(L) ((L)?0x01000000:0)
00387 #else
00388 #if defined(apolloFortran) || defined(vmsFortran) || defined(DECFortran)
00389 #define C2FLOGICAL(L) ((L)?-1:0)        /* These machines use -1/0 for .true./.false. */
00390 #else
00391 #define C2FLOGICAL(L) ((L)? 1:0)        /* All others     use +1/0 for .true./.false. */
00392 #endif
00393 #endif
00394 #endif                          /* LOGICAL_STRICT */
00395 
00396 /* Convert a vector of C strings into FORTRAN strings. */
00397 #ifndef __CF__KnR
00398 static char *c2fstrv(char *cstr, char *fstr, int elem_len, int sizeofcstr)
00399 #else
00400 static char *c2fstrv(cstr, fstr, elem_len, sizeofcstr)
00401 char *cstr;
00402 char *fstr;
00403 int elem_len;
00404 int sizeofcstr;
00405 #endif
00406 {
00407    int i, j;
00408 /* elem_len includes \0 for C strings. Fortran strings don't have term. \0.
00409    Useful size of string must be the same in both languages. */
00410    for (i = 0; i < sizeofcstr / elem_len; i++) {
00411       for (j = 1; j < elem_len && *cstr; j++)
00412          *fstr++ = *cstr++;
00413       cstr += 1 + elem_len - j;
00414       for (; j < elem_len; j++)
00415          *fstr++ = ' ';
00416    }                            /* 95109 - Seems to be returning the original fstr. */
00417    return fstr - sizeofcstr + sizeofcstr / elem_len;
00418 }
00419 
00420 /* Convert a vector of FORTRAN strings into C strings. */
00421 #ifndef __CF__KnR
00422 static char *f2cstrv(char *fstr, char *cstr, int elem_len, int sizeofcstr)
00423 #else
00424 static char *f2cstrv(fstr, cstr, elem_len, sizeofcstr)
00425 char *fstr;
00426 char *cstr;
00427 int elem_len;
00428 int sizeofcstr;
00429 #endif
00430 {
00431    int i, j;
00432 /* elem_len includes \0 for C strings. Fortran strings don't have term. \0.
00433    Useful size of string must be the same in both languages. */
00434    cstr += sizeofcstr;
00435    fstr += sizeofcstr - sizeofcstr / elem_len;
00436    for (i = 0; i < sizeofcstr / elem_len; i++) {
00437       *--cstr = '\0';
00438       for (j = 1; j < elem_len; j++)
00439          *--cstr = *--fstr;
00440    }
00441    return cstr;
00442 }
00443 
00444 /* kill the trailing char t's in string s. */
00445 #ifndef __CF__KnR
00446 static char *kill_trailing(char *s, char t)
00447 #else
00448 static char *kill_trailing(s, t)
00449 char *s;
00450 char t;
00451 #endif
00452 {
00453    char *e;
00454    e = s + strlen(s);
00455    if (e > s) {                 /* Need this to handle NULL string. */
00456       while (e > s && *--e == t);       /* Don't follow t's past beginning. */
00457       e[*e == t ? 0 : 1] = '\0';        /* Handle s[0]=t correctly.       */
00458    }
00459    return s;
00460 }
00461 
00462 /* kill_trailingn(s,t,e) will kill the trailing t's in string s. e normally 
00463 points to the terminating '\0' of s, but may actually point to anywhere in s.
00464 s's new '\0' will be placed at e or earlier in order to remove any trailing t's.
00465 If e<s string s is left unchanged. */
00466 #ifndef __CF__KnR
00467 static char *kill_trailingn(char *s, char t, char *e)
00468 #else
00469 static char *kill_trailingn(s, t, e)
00470 char *s;
00471 char t;
00472 char *e;
00473 #endif
00474 {
00475    if (e == s)
00476       *e = '\0';                /* Kill the string makes sense here. */
00477    else if (e > s) {            /* Watch out for neg. length string. */
00478       while (e > s && *--e == t);       /* Don't follow t's past beginning. */
00479       e[*e == t ? 0 : 1] = '\0';        /* Handle s[0]=t correctly.       */
00480    }
00481    return s;
00482 }
00483 
00484 /* Note the following assumes that any element which has t's to be chopped off,
00485 does indeed fill the entire element. */
00486 #ifndef __CF__KnR
00487 static char *vkill_trailing(char *cstr, int elem_len, int sizeofcstr, char t)
00488 #else
00489 static char *vkill_trailing(cstr, elem_len, sizeofcstr, t)
00490 char *cstr;
00491 int elem_len;
00492 int sizeofcstr;
00493 char t;
00494 #endif
00495 {
00496    int i;
00497    for (i = 0; i < sizeofcstr / elem_len; i++)  /* elem_len includes \0 for C strings. */
00498       kill_trailingn(cstr + elem_len * i, t, cstr + elem_len * (i + 1) - 1);
00499    return cstr;
00500 }
00501 
00502 #ifdef vmsFortran
00503 typedef struct dsc$descriptor_s fstring;
00504 #define DSC$DESCRIPTOR_A(DIMCT)                                                \
00505 struct {                                                                       \
00506   unsigned short dsc$w_length;          unsigned char    dsc$b_dtype;          \
00507   unsigned char  dsc$b_class;                    char   *dsc$a_pointer;        \
00508            char  dsc$b_scale;           unsigned char    dsc$b_digits;         \
00509   struct {                                                                     \
00510     unsigned                   : 3;       unsigned dsc$v_fl_binscale : 1;      \
00511     unsigned dsc$v_fl_redim    : 1;       unsigned dsc$v_fl_column   : 1;      \
00512     unsigned dsc$v_fl_coeff    : 1;       unsigned dsc$v_fl_bounds   : 1;      \
00513   } dsc$b_aflags;                                                              \
00514   unsigned char  dsc$b_dimct;           unsigned long    dsc$l_arsize;         \
00515            char *dsc$a_a0;                       long    dsc$l_m [DIMCT];      \
00516   struct {                                                                     \
00517     long dsc$l_l;                         long dsc$l_u;                        \
00518   } dsc$bounds [DIMCT];                                                        \
00519 }
00520 typedef DSC$DESCRIPTOR_A(1) fstringvector;
00521 /*typedef DSC$DESCRIPTOR_A(2) fstringarrarr;
00522   typedef DSC$DESCRIPTOR_A(3) fstringarrarrarr;*/
00523 #define initfstr(F,C,ELEMNO,ELEMLEN)                                           \
00524 ( (F).dsc$l_arsize=  ( (F).dsc$w_length                        =(ELEMLEN) )    \
00525                     *( (F).dsc$l_m[0]=(F).dsc$bounds[0].dsc$l_u=(ELEMNO)  ),   \
00526   (F).dsc$a_a0    =  ( (F).dsc$a_pointer=(C) ) - (F).dsc$w_length          ,(F))
00527 
00528 #else
00529 #define _NUM_ELEMS      -1
00530 #define _NUM_ELEM_ARG   -2
00531 #define NUM_ELEMS(A)    A,_NUM_ELEMS
00532 #define NUM_ELEM_ARG(B) *_2(A,B),_NUM_ELEM_ARG
00533 #define TERM_CHARS(A,B) A,B
00534 #ifndef __CF__KnR
00535 static int num_elem(char *strv, unsigned elem_len, int term_char, int num_term)
00536 #else
00537 static int num_elem(strv, elem_len, term_char, num_term)
00538 char *strv;
00539 unsigned elem_len;
00540 int term_char;
00541 int num_term;
00542 #endif
00543 /* elem_len is the number of characters in each element of strv, the FORTRAN
00544 vector of strings. The last element of the vector must begin with at least
00545 num_term term_char characters, so that this routine can determine how 
00546 many elements are in the vector. */
00547 {
00548    unsigned num, i;
00549    if (num_term == _NUM_ELEMS || num_term == _NUM_ELEM_ARG)
00550       return term_char;
00551    if (num_term <= 0)
00552       num_term = (int) elem_len;
00553    for (num = 0;; num++) {
00554       for (i = 0; i < (unsigned) num_term && *strv == term_char; i++, strv++);
00555       if (i == (unsigned) num_term)
00556          break;
00557       else
00558          strv += elem_len - i;
00559    }
00560    return (int) num;
00561 }
00562 #endif
00563 /*-------------------------------------------------------------------------*/
00564 
00565 /*           UTILITIES FOR C TO USE STRINGS IN FORTRAN COMMON BLOCKS       */
00566 
00567 /* C string TO Fortran Common Block STRing. */
00568 /* DIM is the number of DIMensions of the array in terms of strings, not
00569    characters. e.g. char a[12] has DIM = 0, char a[12][4] has DIM = 1, etc. */
00570 #define C2FCBSTR(CSTR,FSTR,DIM)                                                \
00571  c2fstrv((char *)CSTR, (char *)FSTR, sizeof(FSTR)/cfelementsof(FSTR,DIM)+1,    \
00572          sizeof(FSTR)+cfelementsof(FSTR,DIM))
00573 
00574 /* Fortran Common Block string TO C STRing. */
00575 #define FCB2CSTR(FSTR,CSTR,DIM)                                                \
00576  vkill_trailing(f2cstrv((char *)FSTR, (char *)CSTR,                            \
00577                         sizeof(FSTR)/cfelementsof(FSTR,DIM)+1,                 \
00578                         sizeof(FSTR)+cfelementsof(FSTR,DIM)),                  \
00579                 sizeof(FSTR)/cfelementsof(FSTR,DIM)+1,                         \
00580                 sizeof(FSTR)+cfelementsof(FSTR,DIM), ' ')
00581 
00582 #define cfDEREFERENCE0
00583 #define cfDEREFERENCE1 *
00584 #define cfDEREFERENCE2 **
00585 #define cfDEREFERENCE3 ***
00586 #define cfDEREFERENCE4 ****
00587 #define cfDEREFERENCE5 *****
00588 #define cfelementsof(A,D) (sizeof(A)/sizeof(_(cfDEREFERENCE,D)(A)))
00589 
00590 /*-------------------------------------------------------------------------*/
00591 
00592 /*               UTILITIES FOR C TO CALL FORTRAN SUBROUTINES               */
00593 
00594 /* Define lookup tables for how to handle the various types of variables.  */
00595 
00596 #ifdef OLD_VAXC                 /* Prevent %CC-I-PARAMNOTUSED. */
00597 #pragma nostandard
00598 #endif
00599 
00600 #define ZTRINGV_NUM(I)       I
00601 #define ZTRINGV_ARGFP(I) (*(_2(A,I)))   /* Undocumented. For PINT, etc. */
00602 #define ZTRINGV_ARGF(I) _2(A,I)
00603 #ifdef CFSUBASFUN
00604 #define ZTRINGV_ARGS(I) ZTRINGV_ARGF(I)
00605 #else
00606 #define ZTRINGV_ARGS(I) _2(B,I)
00607 #endif
00608 
00609 #define    PBYTE_cfVP(A,B) PINT_cfVP(A,B)
00610 #define  PDOUBLE_cfVP(A,B)
00611 #define   PFLOAT_cfVP(A,B)
00612 #ifdef ZTRINGV_ARGS_allows_Pvariables
00613 /* This allows Pvariables for ARGS. ARGF machinery is above ARGFP.
00614  * B is not needed because the variable may be changed by the Fortran routine,
00615  * but because B is the only way to access an arbitrary macro argument.       */
00616 #define     PINT_cfVP(A,B) int  B = (int)A;     /* For ZSTRINGV_ARGS */
00617 #else
00618 #define     PINT_cfVP(A,B)
00619 #endif
00620 #define PLOGICAL_cfVP(A,B) int *B;      /* Returning LOGICAL in FUNn and SUBn */
00621 #define    PLONG_cfVP(A,B) PINT_cfVP(A,B)
00622 #define   PSHORT_cfVP(A,B) PINT_cfVP(A,B)
00623 
00624 #define        VCF_INT_S(T,A,B) _(T,VVVVVVV_cfTYPE) B = A;
00625 #define        VCF_INT_F(T,A,B) _(T,_cfVCF)(A,B)
00626 /* _cfVCF table is directly mapped to _cfCCC table. */
00627 #define     BYTE_cfVCF(A,B)
00628 #define   DOUBLE_cfVCF(A,B)
00629 #if !defined(__CF__KnR)
00630 #define    FLOAT_cfVCF(A,B)
00631 #else
00632 #define    FLOAT_cfVCF(A,B) FORTRAN_REAL B = A;
00633 #endif
00634 #define      INT_cfVCF(A,B)
00635 #define  LOGICAL_cfVCF(A,B)
00636 #define     LONG_cfVCF(A,B)
00637 #define    SHORT_cfVCF(A,B)
00638 
00639 #define VCF(TN,I)       _Icf4(4,V,TN,_(A,I),_(B,I),F)
00640 #define VVCF(TN,AI,BI)  _Icf4(4,V,TN,AI,BI,S)
00641 #define        INT_cfV(T,A,B,F) _(VCF_INT_,F)(T,A,B)
00642 #define       INTV_cfV(T,A,B,F)
00643 #define      INTVV_cfV(T,A,B,F)
00644 #define     INTVVV_cfV(T,A,B,F)
00645 #define    INTVVVV_cfV(T,A,B,F)
00646 #define   INTVVVVV_cfV(T,A,B,F)
00647 #define  INTVVVVVV_cfV(T,A,B,F)
00648 #define INTVVVVVVV_cfV(T,A,B,F)
00649 #define PINT_cfV(      T,A,B,F) _(T,_cfVP)(A,B)
00650 #define PVOID_cfV(     T,A,B,F)
00651 #if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran)
00652 #define    ROUTINE_cfV(T,A,B,F) void (*B)(CF_NULL_PROTO) = (void (*)(CF_NULL_PROTO))A;
00653 #else
00654 #define    ROUTINE_cfV(T,A,B,F)
00655 #endif
00656 #define     SIMPLE_cfV(T,A,B,F)
00657 #ifdef vmsFortran
00658 #define     STRING_cfV(T,A,B,F) static struct {fstring f; unsigned clen;} B =  \
00659                                        {{0,DSC$K_DTYPE_T,DSC$K_CLASS_S,NULL},0};
00660 #define    PSTRING_cfV(T,A,B,F) static fstring B={0,DSC$K_DTYPE_T,DSC$K_CLASS_S,NULL};
00661 #define    STRINGV_cfV(T,A,B,F) static fstringvector B =                       \
00662   {sizeof(A),DSC$K_DTYPE_T,DSC$K_CLASS_A,NULL,0,0,{0,0,1,1,1},1,0,NULL,0,{1,0}};
00663 #define   PSTRINGV_cfV(T,A,B,F) static fstringvector B =                       \
00664           {0,DSC$K_DTYPE_T,DSC$K_CLASS_A,NULL,0,0,{0,0,1,1,1},1,0,NULL,0,{1,0}};
00665 #else
00666 #define     STRING_cfV(T,A,B,F) struct {unsigned int clen, flen;} B;
00667 #define    STRINGV_cfV(T,A,B,F) struct {char *s, *fs; unsigned flen;} B;
00668 #define    PSTRING_cfV(T,A,B,F) int     B;
00669 #define   PSTRINGV_cfV(T,A,B,F) struct{char *fs; unsigned int sizeofA,flen;}B;
00670 #endif
00671 #define    ZTRINGV_cfV(T,A,B,F)  STRINGV_cfV(T,A,B,F)
00672 #define   PZTRINGV_cfV(T,A,B,F) PSTRINGV_cfV(T,A,B,F)
00673 
00674 /* Note that the actions of the A table were performed inside the AA table.
00675    VAX Ultrix vcc, and HP-UX cc, didn't evaluate arguments to functions left to
00676    right, so we had to split the original table into the current robust two. */
00677 #define ACF(NAME,TN,AI,I)      _(TN,_cfSTR)(4,A,NAME,I,AI,_(B,I),0)
00678 #define   DEFAULT_cfA(M,I,A,B)
00679 #define   LOGICAL_cfA(M,I,A,B) B=C2FLOGICAL(B);
00680 #define  PLOGICAL_cfA(M,I,A,B) A=C2FLOGICAL(A);
00681 #define    STRING_cfA(M,I,A,B)  STRING_cfC(M,I,A,B,sizeof(A))
00682 #define   PSTRING_cfA(M,I,A,B) PSTRING_cfC(M,I,A,B,sizeof(A))
00683 #ifdef vmsFortran
00684 #define  AATRINGV_cfA(    A,B, sA,filA,silA)                                   \
00685  initfstr(B,(char *)malloc((sA)-(filA)),(filA),(silA)-1),                      \
00686           c2fstrv(A,B.dsc$a_pointer,(silA),(sA));
00687 #define APATRINGV_cfA(    A,B, sA,filA,silA)                                   \
00688  initfstr(B,A,(filA),(silA)-1),c2fstrv(A,A,(silA),(sA));
00689 #else
00690 #define  AATRINGV_cfA(    A,B, sA,filA,silA)                                   \
00691  (B.s=(char *)malloc((sA)-(filA)),B.fs=c2fstrv(A,B.s,(B.flen=(silA)-1)+1,(sA)));
00692 #define APATRINGV_cfA(    A,B, sA,filA,silA)                                   \
00693  B.fs=c2fstrv(A,A,(B.flen=(silA)-1)+1,B.sizeofA=(sA));
00694 #endif
00695 #define   STRINGV_cfA(M,I,A,B)                                                 \
00696     AATRINGV_cfA((char *)A,B,sizeof(A),firstindexlength(A),secondindexlength(A))
00697 #define  PSTRINGV_cfA(M,I,A,B)                                                 \
00698    APATRINGV_cfA((char *)A,B,sizeof(A),firstindexlength(A),secondindexlength(A))
00699 #define   ZTRINGV_cfA(M,I,A,B)  AATRINGV_cfA( (char *)A,B,                     \
00700                     (_3(M,_ELEMS_,I))*(( _3(M,_ELEMLEN_,I))+1),                \
00701                               (_3(M,_ELEMS_,I)),(_3(M,_ELEMLEN_,I))+1)
00702 #define  PZTRINGV_cfA(M,I,A,B) APATRINGV_cfA( (char *)A,B,                     \
00703                     (_3(M,_ELEMS_,I))*(( _3(M,_ELEMLEN_,I))+1),                \
00704                               (_3(M,_ELEMS_,I)),(_3(M,_ELEMLEN_,I))+1)
00705 
00706 #define    PBYTE_cfAAP(A,B) &A
00707 #define  PDOUBLE_cfAAP(A,B) &A
00708 #define   PFLOAT_cfAAP(A,B) FLOATVVVVVVV_cfPP &A
00709 #define     PINT_cfAAP(A,B) &A
00710 #define PLOGICAL_cfAAP(A,B) B= &A       /* B used to keep a common W table. */
00711 #define    PLONG_cfAAP(A,B) &A
00712 #define   PSHORT_cfAAP(A,B) &A
00713 
00714 #define AACF(TN,AI,I,C) _SEP_(TN,C,COMMA) _Icf(3,AA,TN,AI,_(B,I))
00715 #define        INT_cfAA(T,A,B) &B
00716 #define       INTV_cfAA(T,A,B) _(T,VVVVVV_cfPP) A
00717 #define      INTVV_cfAA(T,A,B) _(T,VVVVV_cfPP)  A[0]
00718 #define     INTVVV_cfAA(T,A,B) _(T,VVVV_cfPP)   A[0][0]
00719 #define    INTVVVV_cfAA(T,A,B) _(T,VVV_cfPP)    A[0][0][0]
00720 #define   INTVVVVV_cfAA(T,A,B) _(T,VV_cfPP)     A[0][0][0][0]
00721 #define  INTVVVVVV_cfAA(T,A,B) _(T,V_cfPP)      A[0][0][0][0][0]
00722 #define INTVVVVVVV_cfAA(T,A,B) _(T,_cfPP)       A[0][0][0][0][0][0]
00723 #define       PINT_cfAA(T,A,B) _(T,_cfAAP)(A,B)
00724 #define      PVOID_cfAA(T,A,B) (void *) A
00725 #if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran)
00726 #define    ROUTINE_cfAA(T,A,B) &B
00727 #else
00728 #define    ROUTINE_cfAA(T,A,B) (void(*)(CF_NULL_PROTO))A
00729 #endif
00730 #define     STRING_cfAA(T,A,B)  STRING_cfCC(T,A,B)
00731 #define    PSTRING_cfAA(T,A,B) PSTRING_cfCC(T,A,B)
00732 #ifdef vmsFortran
00733 #define    STRINGV_cfAA(T,A,B) &B
00734 #else
00735 #ifdef CRAYFortran
00736 #define    STRINGV_cfAA(T,A,B) _cptofcd(B.fs,B.flen)
00737 #else
00738 #define    STRINGV_cfAA(T,A,B) B.fs
00739 #endif
00740 #endif
00741 #define   PSTRINGV_cfAA(T,A,B) STRINGV_cfAA(T,A,B)
00742 #define    ZTRINGV_cfAA(T,A,B) STRINGV_cfAA(T,A,B)
00743 #define   PZTRINGV_cfAA(T,A,B) STRINGV_cfAA(T,A,B)
00744 
00745 #if defined(vmsFortran) || defined(CRAYFortran)
00746 #define JCF(TN,I)
00747 #define KCF(TN,I)
00748 #else
00749 #define JCF(TN,I)    _(TN,_cfSTR)(1,J,_(B,I), 0,0,0,0)
00750 #if defined(AbsoftUNIXFortran)
00751 #define  DEFAULT_cfJ(B) ,0
00752 #else
00753 #define  DEFAULT_cfJ(B)
00754 #endif
00755 #define  LOGICAL_cfJ(B) DEFAULT_cfJ(B)
00756 #define PLOGICAL_cfJ(B) DEFAULT_cfJ(B)
00757 #define   STRING_cfJ(B) ,B.flen
00758 #define  PSTRING_cfJ(B) ,B
00759 #define  STRINGV_cfJ(B) STRING_cfJ(B)
00760 #define PSTRINGV_cfJ(B) STRING_cfJ(B)
00761 #define  ZTRINGV_cfJ(B) STRING_cfJ(B)
00762 #define PZTRINGV_cfJ(B) STRING_cfJ(B)
00763 
00764 /* KCF is identical to DCF, except that KCF ZTRING is not empty. */
00765 #define KCF(TN,I)    _(TN,_cfSTR)(1,KK,_(B,I), 0,0,0,0)
00766 #if defined(AbsoftUNIXFortran)
00767 #define  DEFAULT_cfKK(B) , unsigned B
00768 #else
00769 #define  DEFAULT_cfKK(B)
00770 #endif
00771 #define  LOGICAL_cfKK(B) DEFAULT_cfKK(B)
00772 #define PLOGICAL_cfKK(B) DEFAULT_cfKK(B)
00773 #define   STRING_cfKK(B) , unsigned B
00774 #define  PSTRING_cfKK(B) STRING_cfKK(B)
00775 #define  STRINGV_cfKK(B) STRING_cfKK(B)
00776 #define PSTRINGV_cfKK(B) STRING_cfKK(B)
00777 #define  ZTRINGV_cfKK(B) STRING_cfKK(B)
00778 #define PZTRINGV_cfKK(B) STRING_cfKK(B)
00779 #endif
00780 
00781 #define WCF(TN,AN,I)      _(TN,_cfSTR)(2,W,AN,_(B,I), 0,0,0)
00782 #define  DEFAULT_cfW(A,B)
00783 #define  LOGICAL_cfW(A,B)
00784 #define PLOGICAL_cfW(A,B) *B=F2CLOGICAL(*B);
00785 #define   STRING_cfW(A,B) (A[B.clen]!='\0'?A[B.clen]='\0':0);   /* A?="constnt" */
00786 #define  PSTRING_cfW(A,B) kill_trailing(A,' ');
00787 #ifdef vmsFortran
00788 #define  STRINGV_cfW(A,B) free(B.dsc$a_pointer);
00789 #define PSTRINGV_cfW(A,B)                                                      \
00790   vkill_trailing(f2cstrv((char*)A, (char*)A,                                   \
00791                            B.dsc$w_length+1, B.dsc$l_arsize+B.dsc$l_m[0]),     \
00792                    B.dsc$w_length+1, B.dsc$l_arsize+B.dsc$l_m[0], ' ');
00793 #else
00794 #define  STRINGV_cfW(A,B) free(B.s);
00795 #define PSTRINGV_cfW(A,B) vkill_trailing(                                      \
00796          f2cstrv((char*)A,(char*)A,B.flen+1,B.sizeofA), B.flen+1,B.sizeofA,' ');
00797 #endif
00798 #define  ZTRINGV_cfW(A,B)      STRINGV_cfW(A,B)
00799 #define PZTRINGV_cfW(A,B)     PSTRINGV_cfW(A,B)
00800 
00801 #define   NCF(TN,I,C)       _SEP_(TN,C,COMMA) _Icf(2,N,TN,_(A,I),0)
00802 #define  NNCF(TN,I,C)        UUCF(TN,I,C)
00803 #define NNNCF(TN,I,C)       _SEP_(TN,C,COLON) _Icf(2,N,TN,_(A,I),0)
00804 #define        INT_cfN(T,A) _(T,VVVVVVV_cfTYPE) * A
00805 #define       INTV_cfN(T,A) _(T,VVVVVV_cfTYPE)  * A
00806 #define      INTVV_cfN(T,A) _(T,VVVVV_cfTYPE)   * A
00807 #define     INTVVV_cfN(T,A) _(T,VVVV_cfTYPE)    * A
00808 #define    INTVVVV_cfN(T,A) _(T,VVV_cfTYPE)     * A
00809 #define   INTVVVVV_cfN(T,A) _(T,VV_cfTYPE)      * A
00810 #define  INTVVVVVV_cfN(T,A) _(T,V_cfTYPE)       * A
00811 #define INTVVVVVVV_cfN(T,A) _(T,_cfTYPE)        * A
00812 #define       PINT_cfN(T,A) _(T,_cfTYPE)        * A
00813 #define      PVOID_cfN(T,A) void *                A
00814 #if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran)
00815 #define    ROUTINE_cfN(T,A) void (**A)(CF_NULL_PROTO)
00816 #else
00817 #define    ROUTINE_cfN(T,A) void ( *A)(CF_NULL_PROTO)
00818 #endif
00819 #ifdef vmsFortran
00820 #define     STRING_cfN(T,A) fstring *             A
00821 #define    STRINGV_cfN(T,A) fstringvector *       A
00822 #else
00823 #ifdef CRAYFortran
00824 #define     STRING_cfN(T,A) _fcd                  A
00825 #define    STRINGV_cfN(T,A) _fcd                  A
00826 #else
00827 #define     STRING_cfN(T,A) char *                A
00828 #define    STRINGV_cfN(T,A) char *                A
00829 #endif
00830 #endif
00831 #define    PSTRING_cfN(T,A)   STRING_cfN(T,A)   /* CRAY insists on arg.'s here. */
00832 #define   PNSTRING_cfN(T,A)   STRING_cfN(T,A)   /* CRAY insists on arg.'s here. */
00833 #define   PPSTRING_cfN(T,A)   STRING_cfN(T,A)   /* CRAY insists on arg.'s here. */
00834 #define   PSTRINGV_cfN(T,A)  STRINGV_cfN(T,A)
00835 #define    ZTRINGV_cfN(T,A)  STRINGV_cfN(T,A)
00836 #define   PZTRINGV_cfN(T,A) PSTRINGV_cfN(T,A)
00837 
00838 
00839 /* Apollo 6.7, CRAY, old Sun, VAX/Ultrix vcc/cc and new ultrix
00840    can't hack more than 31 arg's.
00841    e.g. ultrix >= 4.3 gives message:
00842        zow35> cc -c -DDECFortran cfortest.c
00843        cfe: Fatal: Out of memory: cfortest.c
00844        zow35>
00845    Old __hpux had the problem, but new 'HP-UX A.09.03 A 9000/735' is fine
00846    if using -Aa, otherwise we have a problem.
00847  */
00848 #ifndef MAX_PREPRO_ARGS
00849 #if !defined(__GNUC__) && (defined(VAXUltrix) || defined(__CF__APOLLO67) || (defined(sun)&&!defined(__sun)) || defined(_CRAY) || defined(__ultrix__) || (defined(__hpux)&&defined(__CF__KnR)))
00850 #define MAX_PREPRO_ARGS 31
00851 #else
00852 #define MAX_PREPRO_ARGS 99
00853 #endif
00854 #endif
00855 
00856 #if defined(AbsoftUNIXFortran)
00857 /* In addition to explicit Absoft stuff, only Absoft requires:
00858    - DEFAULT coming from _cfSTR.
00859      DEFAULT could have been called e.g. INT, but keep it for clarity.
00860    - M term in CFARGT14 and CFARGT14FS.
00861  */
00862 #define ABSOFT_cf1(T0) _(T0,_cfSTR)(0,ABSOFT1,0,0,0,0,0)
00863 #define ABSOFT_cf2(T0) _(T0,_cfSTR)(0,ABSOFT2,0,0,0,0,0)
00864 #define ABSOFT_cf3(T0) _(T0,_cfSTR)(0,ABSOFT3,0,0,0,0,0)
00865 #define DEFAULT_cfABSOFT1
00866 #define LOGICAL_cfABSOFT1
00867 #define  STRING_cfABSOFT1 ,MAX_LEN_FORTRAN_FUNCTION_STRING
00868 #define DEFAULT_cfABSOFT2
00869 #define LOGICAL_cfABSOFT2
00870 #define  STRING_cfABSOFT2 ,unsigned D0
00871 #define DEFAULT_cfABSOFT3
00872 #define LOGICAL_cfABSOFT3
00873 #define  STRING_cfABSOFT3 ,D0
00874 #else
00875 #define ABSOFT_cf1(T0)
00876 #define ABSOFT_cf2(T0)
00877 #define ABSOFT_cf3(T0)
00878 #endif
00879 
00880 /* _Z introduced to cicumvent IBM and HP silly preprocessor warning.
00881    e.g. "Macro CFARGT14 invoked with a null argument."
00882  */
00883 #define _Z
00884 
00885 #define  CFARGT14S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)                \
00886  S(T1,1)   S(T2,2)   S(T3,3)   S(T4,4)   S(T5,5)   S(T6,6)   S(T7,7)           \
00887  S(T8,8)   S(T9,9)   S(TA,A)   S(TB,B)   S(TC,C)   S(TD,D)   S(TE,E)
00888 #define  CFARGT14FS(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)           \
00889  F(T1,1,0) F(T2,2,1) F(T3,3,1) F(T4,4,1) F(T5,5,1) F(T6,6,1) F(T7,7,1)         \
00890  F(T8,8,1) F(T9,9,1) F(TA,A,1) F(TB,B,1) F(TC,C,1) F(TD,D,1) F(TE,E,1)         \
00891  M       CFARGT14S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
00892 
00893 #if !(defined(PowerStationFortran)||defined(hpuxFortran800))
00894 /*  Old CFARGT14 -> CFARGT14FS as seen below, for Absoft cross-compile yields:
00895       SunOS> cc -c -Xa -DAbsoftUNIXFortran c.c
00896       "c.c", line 406: warning: argument mismatch
00897     Haven't checked if this is ANSI C or a SunOS bug. SunOS -Xs works ok.
00898     Behavior is most clearly seen in example:
00899       #define A 1 , 2
00900       #define  C(X,Y,Z) x=X. y=Y. z=Z.
00901       #define  D(X,Y,Z) C(X,Y,Z)
00902       D(x,A,z)
00903     Output from preprocessor is: x = x . y = 1 . z = 2 .
00904  #define CFARGT14(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
00905        CFARGT14FS(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
00906 */
00907 #define  CFARGT14(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)             \
00908  F(T1,1,0) F(T2,2,1) F(T3,3,1) F(T4,4,1) F(T5,5,1) F(T6,6,1) F(T7,7,1)         \
00909  F(T8,8,1) F(T9,9,1) F(TA,A,1) F(TB,B,1) F(TC,C,1) F(TD,D,1) F(TE,E,1)         \
00910  M       CFARGT14S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
00911 /* F changed to Z for arg 15. Watch out if ever extend to S or Z arguments. */
00912 #define  CFARGT20(Z,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \
00913  Z(T1,1,0) Z(T2,2,1) Z(T3,3,1) Z(T4,4,1) Z(T5,5,1) Z(T6,6,1) Z(T7,7,1)         \
00914  Z(T8,8,1) Z(T9,9,1) Z(TA,A,1) Z(TB,B,1) Z(TC,C,1) Z(TD,D,1) Z(TE,E,1)         \
00915  Z(TF,F,1) Z(TG,G,1) Z(TH,H,1) Z(TI,I,1) Z(TJ,J,1) Z(TK,K,1)                   \
00916  S(T1,1)   S(T2,2)   S(T3,3)   S(T4,4)   S(T5,5)   S(T6,6)   S(T7,7)           \
00917  S(T8,8)   S(T9,9)   S(TA,A)   S(TB,B)   S(TC,C)   S(TD,D)   S(TE,E)           \
00918  S(TF,F)   S(TG,G)   S(TH,H)   S(TI,I)   S(TJ,J)   S(TK,K)
00919 #define CFARGTA14(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE) \
00920  F(T1,A1,1,0) F(T2,A2,2,1) F(T3,A3,3,1) F(T4,A4,4,1) F(T5,A5,5,1) F(T6,A6,6,1) \
00921  F(T7,A7,7,1) F(T8,A8,8,1) F(T9,A9,9,1) F(TA,AA,A,1) F(TB,AB,B,1) F(TC,AC,C,1) \
00922  F(TD,AD,D,1) F(TE,AE,E,1) S(T1,1)      S(T2,2)      S(T3,3)      S(T4,4)      \
00923  S(T5,5)      S(T6,6)      S(T7,7)      S(T8,8)      S(T9,9)      S(TA,A)      \
00924  S(TB,B)      S(TC,C)      S(TD,D)      S(TE,E)
00925 #if MAX_PREPRO_ARGS>31
00926 /* F changed to Z for arg 15. Watch out if ever extend to S or Z arguments. */
00927 #define CFARGTA20(Z,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) \
00928  Z(T1,A1,1,0) Z(T2,A2,2,1) Z(T3,A3,3,1) Z(T4,A4,4,1) Z(T5,A5,5,1) Z(T6,A6,6,1) \
00929  Z(T7,A7,7,1) Z(T8,A8,8,1) Z(T9,A9,9,1) Z(TA,AA,A,1) Z(TB,AB,B,1) Z(TC,AC,C,1) \
00930  Z(TD,AD,D,1) Z(TE,AE,E,1) Z(TF,AF,F,1) Z(TG,AG,G,1) Z(TH,AH,H,1) Z(TI,AI,I,1) \
00931  Z(TJ,AJ,J,1) Z(TK,AK,K,1) S(T1,1)      S(T2,2)      S(T3,3)      S(T4,4)      \
00932  S(T5,5)      S(T6,6)      S(T7,7)      S(T8,8)      S(T9,9)      S(TA,A)      \
00933  S(TB,B)      S(TC,C)      S(TD,D)      S(TE,E)      S(TF,F)      S(TG,G)      \
00934  S(TH,H)      S(TI,I)      S(TJ,J)      S(TK,K)
00935 #endif
00936 #else
00937 #define  CFARGT14(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)             \
00938  F(T1,1,0) S(T1,1) F(T2,2,1) S(T2,2) F(T3,3,1) S(T3,3) F(T4,4,1) S(T4,4)       \
00939  F(T5,5,1) S(T5,5) F(T6,6,1) S(T6,6) F(T7,7,1) S(T7,7) F(T8,8,1) S(T8,8)       \
00940  F(T9,9,1) S(T9,9) F(TA,A,1) S(TA,A) F(TB,B,1) S(TB,B) F(TC,C,1) S(TC,C)       \
00941  F(TD,D,1) S(TD,D) F(TE,E,1) S(TE,E)
00942 /* F changed to Z for arg 15. Watch out if ever extend to S or Z arguments. */
00943 #define  CFARGT20(Z,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \
00944  Z(T1,1,0) S(T1,1) Z(T2,2,1) S(T2,2) Z(T3,3,1) S(T3,3) Z(T4,4,1) S(T4,4)       \
00945  Z(T5,5,1) S(T5,5) Z(T6,6,1) S(T6,6) Z(T7,7,1) S(T7,7) Z(T8,8,1) S(T8,8)       \
00946  Z(T9,9,1) S(T9,9) Z(TA,A,1) S(TA,A) Z(TB,B,1) S(TB,B) Z(TC,C,1) S(TC,C)       \
00947  Z(TD,D,1) S(TD,D) Z(TE,E,1) S(TE,E) Z(TF,F,1) S(TF,F) Z(TG,G,1) S(TG,G)       \
00948  Z(TH,H,1) S(TH,H) Z(TI,I,1) S(TI,I) Z(TJ,J,1) S(TJ,J) Z(TK,K,1) S(TK,K)
00949 #define CFARGTA14(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE) \
00950  F(T1,A1,1,0) S(T1,1) F(T2,A2,2,1) S(T2,2) F(T3,A3,3,1) S(T3,3)                \
00951  F(T4,A4,4,1) S(T4,4) F(T5,A5,5,1) S(T5,5) F(T6,A6,6,1) S(T6,6)                \
00952  F(T7,A7,7,1) S(T7,7) F(T8,A8,8,1) S(T8,8) F(T9,A9,9,1) S(T9,9)                \
00953  F(TA,AA,A,1) S(TA,A) F(TB,AB,B,1) S(TB,B) F(TC,AC,C,1) S(TC,C)                \
00954  F(TD,AD,D,1) S(TD,D) F(TE,AE,E,1) S(TE,E)
00955 #if MAX_PREPRO_ARGS>31
00956 /* F changed to Z for arg 15. Watch out if ever extend to S or Z arguments. */
00957 #define CFARGTA20(Z,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) \
00958  Z(T1,A1,1,0) S(T1,1) Z(T2,A2,2,1) S(T2,2) Z(T3,A3,3,1) S(T3,3)                \
00959  Z(T4,A4,4,1) S(T4,4) Z(T5,A5,5,1) S(T5,5) Z(T6,A6,6,1) S(T6,6)                \
00960  Z(T7,A7,7,1) S(T7,7) Z(T8,A8,8,1) S(T8,8) Z(T9,A9,9,1) S(T9,9)                \
00961  Z(TA,AA,A,1) S(TA,A) Z(TB,AB,B,1) S(TB,B) Z(TC,AC,C,1) S(TC,C)                \
00962  Z(TD,AD,D,1) S(TD,D) Z(TE,AE,E,1) S(TE,E) Z(TF,AF,F,1) S(TF,F)                \
00963  Z(TG,AG,G,1) S(TG,G) Z(TH,AH,H,1) S(TH,H) Z(TI,AI,I,1) S(TI,I)                \
00964  Z(TJ,AJ,J,1) S(TJ,J) Z(TK,AK,K,1) S(TK,K)
00965 #endif
00966 #endif
00967 
00968 
00969 #define PROTOCCALLSFSUB1( UN,LN,T1) \
00970         PROTOCCALLSFSUB14(UN,LN,T1,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
00971 #define PROTOCCALLSFSUB2( UN,LN,T1,T2) \
00972         PROTOCCALLSFSUB14(UN,LN,T1,T2,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
00973 #define PROTOCCALLSFSUB3( UN,LN,T1,T2,T3) \
00974         PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
00975 #define PROTOCCALLSFSUB4( UN,LN,T1,T2,T3,T4) \
00976         PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
00977 #define PROTOCCALLSFSUB5( UN,LN,T1,T2,T3,T4,T5) \
00978         PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
00979 #define PROTOCCALLSFSUB6( UN,LN,T1,T2,T3,T4,T5,T6) \
00980         PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
00981 #define PROTOCCALLSFSUB7( UN,LN,T1,T2,T3,T4,T5,T6,T7) \
00982         PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
00983 #define PROTOCCALLSFSUB8( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \
00984         PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
00985 #define PROTOCCALLSFSUB9( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \
00986         PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0,CF_0,CF_0,CF_0,CF_0)
00987 #define PROTOCCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \
00988         PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0)
00989 #define PROTOCCALLSFSUB11(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \
00990         PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0)
00991 #define PROTOCCALLSFSUB12(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \
00992         PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0)
00993 #define PROTOCCALLSFSUB13(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \
00994         PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0)
00995 
00996 
00997 #define PROTOCCALLSFSUB15(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF) \
00998         PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,CF_0,CF_0,CF_0,CF_0,CF_0)
00999 #define PROTOCCALLSFSUB16(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG) \
01000         PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,CF_0,CF_0,CF_0,CF_0)
01001 #define PROTOCCALLSFSUB17(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH) \
01002         PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,CF_0,CF_0,CF_0)
01003 #define PROTOCCALLSFSUB18(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI) \
01004         PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,CF_0,CF_0)
01005 #define PROTOCCALLSFSUB19(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ) \
01006         PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,CF_0)
01007 
01008 
01009 #ifndef FCALLSC_QUALIFIER
01010 #ifdef VISUAL_CPLUSPLUS
01011 #define FCALLSC_QUALIFIER __stdcall
01012 #else
01013 #define FCALLSC_QUALIFIER
01014 #endif
01015 #endif
01016 
01017 #ifdef __cplusplus
01018 #define CFextern extern "C"
01019 #else
01020 #define CFextern extern
01021 #endif
01022 
01023 
01024 #ifdef CFSUBASFUN
01025 #define PROTOCCALLSFSUB0(UN,LN) \
01026    PROTOCCALLSFFUN0( VOID,UN,LN)
01027 #define PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
01028    PROTOCCALLSFFUN14(VOID,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
01029 #define PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)\
01030    PROTOCCALLSFFUN20(VOID,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)
01031 #else
01032 /* Note: Prevent compiler warnings, null #define PROTOCCALLSFSUB14/20 after 
01033    #include-ing cfortran.h if calling the FORTRAN wrapper within the same 
01034    source code where the wrapper is created. */
01035 #define PROTOCCALLSFSUB0(UN,LN)     CFextern void FCALLSC_QUALIFIER CFC_(UN,LN)();
01036 #ifndef __CF__KnR
01037 #define PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
01038  CFextern void FCALLSC_QUALIFIER CFC_(UN,LN)( CFARGT14(NCF,KCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) );
01039 #define PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)\
01040  CFextern void FCALLSC_QUALIFIER CFC_(UN,LN)( CFARGT20(NCF,KCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) );
01041 #else
01042 #define PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)     \
01043          PROTOCCALLSFSUB0(UN,LN)
01044 #define PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \
01045          PROTOCCALLSFSUB0(UN,LN)
01046 #endif
01047 #endif
01048 
01049 
01050 #ifdef OLD_VAXC                 /* Allow %CC-I-PARAMNOTUSED. */
01051 #pragma standard
01052 #endif
01053 
01054 
01055 #define CCALLSFSUB1( UN,LN,T1,                        A1)         \
01056         CCALLSFSUB5 (UN,LN,T1,CF_0,CF_0,CF_0,CF_0,A1,0,0,0,0)
01057 #define CCALLSFSUB2( UN,LN,T1,T2,                     A1,A2)      \
01058         CCALLSFSUB5 (UN,LN,T1,T2,CF_0,CF_0,CF_0,A1,A2,0,0,0)
01059 #define CCALLSFSUB3( UN,LN,T1,T2,T3,                  A1,A2,A3)   \
01060         CCALLSFSUB5 (UN,LN,T1,T2,T3,CF_0,CF_0,A1,A2,A3,0,0)
01061 #define CCALLSFSUB4( UN,LN,T1,T2,T3,T4,               A1,A2,A3,A4)\
01062         CCALLSFSUB5 (UN,LN,T1,T2,T3,T4,CF_0,A1,A2,A3,A4,0)
01063 #define CCALLSFSUB5( UN,LN,T1,T2,T3,T4,T5,            A1,A2,A3,A4,A5)          \
01064         CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,0,0,0,0,0)
01065 #define CCALLSFSUB6( UN,LN,T1,T2,T3,T4,T5,T6,         A1,A2,A3,A4,A5,A6)       \
01066         CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,0,0,0,0)
01067 #define CCALLSFSUB7( UN,LN,T1,T2,T3,T4,T5,T6,T7,      A1,A2,A3,A4,A5,A6,A7)    \
01068         CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,0,0,0)
01069 #define CCALLSFSUB8( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,   A1,A2,A3,A4,A5,A6,A7,A8) \
01070         CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,0,0)
01071 #define CCALLSFSUB9( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,A1,A2,A3,A4,A5,A6,A7,A8,A9)\
01072         CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,0)
01073 #define CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA)\
01074         CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,0,0,0,0)
01075 #define CCALLSFSUB11(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB)\
01076         CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,0,0,0)
01077 #define CCALLSFSUB12(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC)\
01078         CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,0,0)
01079 #define CCALLSFSUB13(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD)\
01080         CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,0)
01081 
01082 #ifdef __cplusplus
01083 #define CPPPROTOCLSFSUB0( UN,LN)
01084 #define CPPPROTOCLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
01085 #define CPPPROTOCLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)
01086 #else
01087 #define CPPPROTOCLSFSUB0(UN,LN) \
01088         PROTOCCALLSFSUB0(UN,LN)
01089 #define CPPPROTOCLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)     \
01090         PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
01091 #define CPPPROTOCLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \
01092         PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)
01093 #endif
01094 
01095 #ifdef CFSUBASFUN
01096 #define CCALLSFSUB0(UN,LN) CCALLSFFUN0(UN,LN)
01097 #define CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE)\
01098         CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE)
01099 #else
01100 /* do{...}while(FALSE) allows if(a==b) FORT(); else BORT(); */
01101 #define CCALLSFSUB0( UN,LN) do{CPPPROTOCLSFSUB0(UN,LN) CFC_(UN,LN)();}while(FALSE)
01102 #define CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE)\
01103 do{VVCF(T1,A1,B1) VVCF(T2,A2,B2) VVCF(T3,A3,B3) VVCF(T4,A4,B4) VVCF(T5,A5,B5)  \
01104    VVCF(T6,A6,B6) VVCF(T7,A7,B7) VVCF(T8,A8,B8) VVCF(T9,A9,B9) VVCF(TA,AA,BA)  \
01105    VVCF(TB,AB,BB) VVCF(TC,AC,BC) VVCF(TD,AD,BD) VVCF(TE,AE,BE)                 \
01106    CPPPROTOCLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)          \
01107    ACF(LN,T1,A1,1) ACF(LN,T2,A2,2) ACF(LN,T3,A3,3)                             \
01108    ACF(LN,T4,A4,4) ACF(LN,T5,A5,5) ACF(LN,T6,A6,6) ACF(LN,T7,A7,7)             \
01109    ACF(LN,T8,A8,8) ACF(LN,T9,A9,9) ACF(LN,TA,AA,A) ACF(LN,TB,AB,B)             \
01110    ACF(LN,TC,AC,C) ACF(LN,TD,AD,D) ACF(LN,TE,AE,E)                             \
01111    CFC_(UN,LN)( CFARGTA14(AACF,JCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE) );\
01112    WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5)            \
01113    WCF(T6,A6,6) WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,AA,A)            \
01114    WCF(TB,AB,B) WCF(TC,AC,C) WCF(TD,AD,D) WCF(TE,AE,E)             }while(FALSE)
01115 #endif
01116 
01117 
01118 #if MAX_PREPRO_ARGS>31
01119 #define CCALLSFSUB15(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF)\
01120         CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,CF_0,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,0,0,0,0,0)
01121 #define CCALLSFSUB16(UN,LN,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)\
01122         CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,0,0,0,0)
01123 #define CCALLSFSUB17(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH)\
01124         CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,0,0,0)
01125 #define CCALLSFSUB18(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI)\
01126         CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,0,0)
01127 #define CCALLSFSUB19(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ)\
01128         CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,0)
01129 
01130 #ifdef CFSUBASFUN
01131 #define CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH, \
01132         TI,TJ,TK, A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) \
01133         CCALLSFFUN20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH, \
01134         TI,TJ,TK, A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK)
01135 #else
01136 #define CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH, \
01137         TI,TJ,TK, A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) \
01138 do{VVCF(T1,A1,B1) VVCF(T2,A2,B2) VVCF(T3,A3,B3) VVCF(T4,A4,B4) VVCF(T5,A5,B5)  \
01139    VVCF(T6,A6,B6) VVCF(T7,A7,B7) VVCF(T8,A8,B8) VVCF(T9,A9,B9) VVCF(TA,AA,BA)  \
01140    VVCF(TB,AB,BB) VVCF(TC,AC,BC) VVCF(TD,AD,BD) VVCF(TE,AE,BE) VVCF(TF,AF,BF)  \
01141    VVCF(TG,AG,BG) VVCF(TH,AH,BH) VVCF(TI,AI,BI) VVCF(TJ,AJ,BJ) VVCF(TK,AK,BK)  \
01142    CPPPROTOCLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)  \
01143    ACF(LN,T1,A1,1) ACF(LN,T2,A2,2) ACF(LN,T3,A3,3) ACF(LN,T4,A4,4)             \
01144    ACF(LN,T5,A5,5) ACF(LN,T6,A6,6) ACF(LN,T7,A7,7) ACF(LN,T8,A8,8)             \
01145    ACF(LN,T9,A9,9) ACF(LN,TA,AA,A) ACF(LN,TB,AB,B) ACF(LN,TC,AC,C)             \
01146    ACF(LN,TD,AD,D) ACF(LN,TE,AE,E) ACF(LN,TF,AF,F) ACF(LN,TG,AG,G)             \
01147    ACF(LN,TH,AH,H) ACF(LN,TI,AI,I) ACF(LN,TJ,AJ,J) ACF(LN,TK,AK,K)             \
01148    CFC_(UN,LN)( CFARGTA20(AACF,JCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) ); \
01149  WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) WCF(T6,A6,6) \
01150  WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,AA,A) WCF(TB,AB,B) WCF(TC,AC,C) \
01151  WCF(TD,AD,D) WCF(TE,AE,E) WCF(TF,AF,F) WCF(TG,AG,G) WCF(TH,AH,H) WCF(TI,AI,I) \
01152  WCF(TJ,AJ,J) WCF(TK,AK,K) }while(FALSE)
01153 #endif
01154 #endif                          /* MAX_PREPRO_ARGS */
01155 
01156 /*-------------------------------------------------------------------------*/
01157 
01158 /*               UTILITIES FOR C TO CALL FORTRAN FUNCTIONS                 */
01159 
01160 /*N.B. PROTOCCALLSFFUNn(..) generates code, whether or not the FORTRAN
01161   function is called. Therefore, especially for creator's of C header files
01162   for large FORTRAN libraries which include many functions, to reduce
01163   compile time and object code size, it may be desirable to create
01164   preprocessor directives to allow users to create code for only those
01165   functions which they use.                                                */
01166 
01167 /* The following defines the maximum length string that a function can return.
01168    Of course it may be undefine-d and re-define-d before individual
01169    PROTOCCALLSFFUNn(..) as required. It would also be nice to have this derived
01170    from the individual machines' limits.                                      */
01171 #define MAX_LEN_FORTRAN_FUNCTION_STRING 0x4FE
01172 
01173 /* The following defines a character used by CFORTRAN.H to flag the end of a
01174    string coming out of a FORTRAN routine.                                 */
01175 #define CFORTRAN_NON_CHAR 0x7F
01176 
01177 #ifdef OLD_VAXC                 /* Prevent %CC-I-PARAMNOTUSED. */
01178 #pragma nostandard
01179 #endif
01180 
01181 #define _SEP_(TN,C,COMMA)     _(__SEP_,C)(TN,COMMA)
01182 #define __SEP_0(TN,COMMA)
01183 #define __SEP_1(TN,COMMA)     _Icf(2,SEP,TN,COMMA,0)
01184 #define        INT_cfSEP(T,B) _(A,B)
01185 #define       INTV_cfSEP(T,B) INT_cfSEP(T,B)
01186 #define      INTVV_cfSEP(T,B) INT_cfSEP(T,B)
01187 #define     INTVVV_cfSEP(T,B) INT_cfSEP(T,B)
01188 #define    INTVVVV_cfSEP(T,B) INT_cfSEP(T,B)
01189 #define   INTVVVVV_cfSEP(T,B) INT_cfSEP(T,B)
01190 #define  INTVVVVVV_cfSEP(T,B) INT_cfSEP(T,B)
01191 #define INTVVVVVVV_cfSEP(T,B) INT_cfSEP(T,B)
01192 #define       PINT_cfSEP(T,B) INT_cfSEP(T,B)
01193 #define      PVOID_cfSEP(T,B) INT_cfSEP(T,B)
01194 #define    ROUTINE_cfSEP(T,B) INT_cfSEP(T,B)
01195 #define     SIMPLE_cfSEP(T,B) INT_cfSEP(T,B)
01196 #define       VOID_cfSEP(T,B) INT_cfSEP(T,B)    /* For FORTRAN calls C subr.s. */
01197 #define     STRING_cfSEP(T,B) INT_cfSEP(T,B)
01198 #define    STRINGV_cfSEP(T,B) INT_cfSEP(T,B)
01199 #define    PSTRING_cfSEP(T,B) INT_cfSEP(T,B)
01200 #define   PSTRINGV_cfSEP(T,B) INT_cfSEP(T,B)
01201 #define   PNSTRING_cfSEP(T,B) INT_cfSEP(T,B)
01202 #define   PPSTRING_cfSEP(T,B) INT_cfSEP(T,B)
01203 #define    ZTRINGV_cfSEP(T,B) INT_cfSEP(T,B)
01204 #define   PZTRINGV_cfSEP(T,B) INT_cfSEP(T,B)
01205 
01206 #if defined(SIGNED_BYTE) || !defined(UNSIGNED_BYTE)
01207 #ifdef OLD_VAXC
01208 #define INTEGER_BYTE               char /* Old VAXC barfs on 'signed char' */
01209 #else
01210 #define INTEGER_BYTE        signed char /* default */
01211 #endif
01212 #else
01213 #define INTEGER_BYTE        unsigned char
01214 #endif
01215 #define    BYTEVVVVVVV_cfTYPE INTEGER_BYTE
01216 #define  DOUBLEVVVVVVV_cfTYPE DOUBLE_PRECISION
01217 #define   FLOATVVVVVVV_cfTYPE FORTRAN_REAL
01218 #define     INTVVVVVVV_cfTYPE int
01219 #define LOGICALVVVVVVV_cfTYPE int
01220 #define    LONGVVVVVVV_cfTYPE long
01221 #define   SHORTVVVVVVV_cfTYPE short
01222 #define          PBYTE_cfTYPE INTEGER_BYTE
01223 #define        PDOUBLE_cfTYPE DOUBLE_PRECISION
01224 #define         PFLOAT_cfTYPE FORTRAN_REAL
01225 #define           PINT_cfTYPE int
01226 #define       PLOGICAL_cfTYPE int
01227 #define          PLONG_cfTYPE long
01228 #define         PSHORT_cfTYPE short
01229 
01230 #define CFARGS0(A,T,V,W,X,Y,Z) _3(T,_cf,A)
01231 #define CFARGS1(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V)
01232 #define CFARGS2(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W)
01233 #define CFARGS3(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W,X)
01234 #define CFARGS4(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W,X,Y)
01235 #define CFARGS5(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W,X,Y,Z)
01236 
01237 #define  _Icf(N,T,I,X,Y)                 _(I,_cfINT)(N,T,I,X,Y,0)
01238 #define _Icf4(N,T,I,X,Y,Z)               _(I,_cfINT)(N,T,I,X,Y,Z)
01239 #define           BYTE_cfINT(N,A,B,X,Y,Z)        DOUBLE_cfINT(N,A,B,X,Y,Z)
01240 #define         DOUBLE_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INT,B,X,Y,Z,0)
01241 #define          FLOAT_cfINT(N,A,B,X,Y,Z)        DOUBLE_cfINT(N,A,B,X,Y,Z)
01242 #define            INT_cfINT(N,A,B,X,Y,Z)        DOUBLE_cfINT(N,A,B,X,Y,Z)
01243 #define        LOGICAL_cfINT(N,A,B,X,Y,Z)        DOUBLE_cfINT(N,A,B,X,Y,Z)
01244 #define           LONG_cfINT(N,A,B,X,Y,Z)        DOUBLE_cfINT(N,A,B,X,Y,Z)
01245 #define          SHORT_cfINT(N,A,B,X,Y,Z)        DOUBLE_cfINT(N,A,B,X,Y,Z)
01246 #define          PBYTE_cfINT(N,A,B,X,Y,Z)       PDOUBLE_cfINT(N,A,B,X,Y,Z)
01247 #define        PDOUBLE_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,PINT,B,X,Y,Z,0)
01248 #define         PFLOAT_cfINT(N,A,B,X,Y,Z)       PDOUBLE_cfINT(N,A,B,X,Y,Z)
01249 #define           PINT_cfINT(N,A,B,X,Y,Z)       PDOUBLE_cfINT(N,A,B,X,Y,Z)
01250 #define       PLOGICAL_cfINT(N,A,B,X,Y,Z)       PDOUBLE_cfINT(N,A,B,X,Y,Z)
01251 #define          PLONG_cfINT(N,A,B,X,Y,Z)       PDOUBLE_cfINT(N,A,B,X,Y,Z)
01252 #define         PSHORT_cfINT(N,A,B,X,Y,Z)       PDOUBLE_cfINT(N,A,B,X,Y,Z)
01253 #define          BYTEV_cfINT(N,A,B,X,Y,Z)       DOUBLEV_cfINT(N,A,B,X,Y,Z)
01254 #define         BYTEVV_cfINT(N,A,B,X,Y,Z)      DOUBLEVV_cfINT(N,A,B,X,Y,Z)
01255 #define        BYTEVVV_cfINT(N,A,B,X,Y,Z)     DOUBLEVVV_cfINT(N,A,B,X,Y,Z)
01256 #define       BYTEVVVV_cfINT(N,A,B,X,Y,Z)    DOUBLEVVVV_cfINT(N,A,B,X,Y,Z)
01257 #define      BYTEVVVVV_cfINT(N,A,B,X,Y,Z)   DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z)
01258 #define     BYTEVVVVVV_cfINT(N,A,B,X,Y,Z)  DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z)
01259 #define    BYTEVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z)
01260 #define        DOUBLEV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTV,B,X,Y,Z,0)
01261 #define       DOUBLEVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVV,B,X,Y,Z,0)
01262 #define      DOUBLEVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVV,B,X,Y,Z,0)
01263 #define     DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVV,B,X,Y,Z,0)
01264 #define    DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVVV,B,X,Y,Z,0)
01265 #define   DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVVVV,B,X,Y,Z,0)
01266 #define  DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVVVVV,B,X,Y,Z,0)
01267 #define         FLOATV_cfINT(N,A,B,X,Y,Z)       DOUBLEV_cfINT(N,A,B,X,Y,Z)
01268 #define        FLOATVV_cfINT(N,A,B,X,Y,Z)      DOUBLEVV_cfINT(N,A,B,X,Y,Z)
01269 #define       FLOATVVV_cfINT(N,A,B,X,Y,Z)     DOUBLEVVV_cfINT(N,A,B,X,Y,Z)
01270 #define      FLOATVVVV_cfINT(N,A,B,X,Y,Z)    DOUBLEVVVV_cfINT(N,A,B,X,Y,Z)
01271 #define     FLOATVVVVV_cfINT(N,A,B,X,Y,Z)   DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z)
01272 #define    FLOATVVVVVV_cfINT(N,A,B,X,Y,Z)  DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z)
01273 #define   FLOATVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z)
01274 #define           INTV_cfINT(N,A,B,X,Y,Z)       DOUBLEV_cfINT(N,A,B,X,Y,Z)
01275 #define          INTVV_cfINT(N,A,B,X,Y,Z)      DOUBLEVV_cfINT(N,A,B,X,Y,Z)
01276 #define         INTVVV_cfINT(N,A,B,X,Y,Z)     DOUBLEVVV_cfINT(N,A,B,X,Y,Z)
01277 #define        INTVVVV_cfINT(N,A,B,X,Y,Z)    DOUBLEVVVV_cfINT(N,A,B,X,Y,Z)
01278 #define       INTVVVVV_cfINT(N,A,B,X,Y,Z)   DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z)
01279 #define      INTVVVVVV_cfINT(N,A,B,X,Y,Z)  DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z)
01280 #define     INTVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z)
01281 #define       LOGICALV_cfINT(N,A,B,X,Y,Z)       DOUBLEV_cfINT(N,A,B,X,Y,Z)
01282 #define      LOGICALVV_cfINT(N,A,B,X,Y,Z)      DOUBLEVV_cfINT(N,A,B,X,Y,Z)
01283 #define     LOGICALVVV_cfINT(N,A,B,X,Y,Z)     DOUBLEVVV_cfINT(N,A,B,X,Y,Z)
01284 #define    LOGICALVVVV_cfINT(N,A,B,X,Y,Z)    DOUBLEVVVV_cfINT(N,A,B,X,Y,Z)
01285 #define   LOGICALVVVVV_cfINT(N,A,B,X,Y,Z)   DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z)
01286 #define  LOGICALVVVVVV_cfINT(N,A,B,X,Y,Z)  DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z)
01287 #define LOGICALVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z)
01288 #define          LONGV_cfINT(N,A,B,X,Y,Z)       DOUBLEV_cfINT(N,A,B,X,Y,Z)
01289 #define         LONGVV_cfINT(N,A,B,X,Y,Z)      DOUBLEVV_cfINT(N,A,B,X,Y,Z)
01290 #define        LONGVVV_cfINT(N,A,B,X,Y,Z)     DOUBLEVVV_cfINT(N,A,B,X,Y,Z)
01291 #define       LONGVVVV_cfINT(N,A,B,X,Y,Z)    DOUBLEVVVV_cfINT(N,A,B,X,Y,Z)
01292 #define      LONGVVVVV_cfINT(N,A,B,X,Y,Z)   DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z)
01293 #define     LONGVVVVVV_cfINT(N,A,B,X,Y,Z)  DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z)
01294 #define    LONGVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z)
01295 #define         SHORTV_cfINT(N,A,B,X,Y,Z)       DOUBLEV_cfINT(N,A,B,X,Y,Z)
01296 #define        SHORTVV_cfINT(N,A,B,X,Y,Z)      DOUBLEVV_cfINT(N,A,B,X,Y,Z)
01297 #define       SHORTVVV_cfINT(N,A,B,X,Y,Z)     DOUBLEVVV_cfINT(N,A,B,X,Y,Z)
01298 #define      SHORTVVVV_cfINT(N,A,B,X,Y,Z)    DOUBLEVVVV_cfINT(N,A,B,X,Y,Z)
01299 #define     SHORTVVVVV_cfINT(N,A,B,X,Y,Z)   DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z)
01300 #define    SHORTVVVVVV_cfINT(N,A,B,X,Y,Z)  DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z)
01301 #define   SHORTVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z)
01302 #define          PVOID_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,B,B,X,Y,Z,0)
01303 #define        ROUTINE_cfINT(N,A,B,X,Y,Z)         PVOID_cfINT(N,A,B,X,Y,Z)
01304 /*CRAY coughs on the first,
01305   i.e. the usual trouble of not being able to
01306   define macros to macros with arguments. 
01307   New ultrix is worse, it coughs on all such uses.
01308  */
01309 /*#define       SIMPLE_cfINT                    PVOID_cfINT*/
01310 #define         SIMPLE_cfINT(N,A,B,X,Y,Z)         PVOID_cfINT(N,A,B,X,Y,Z)
01311 #define           VOID_cfINT(N,A,B,X,Y,Z)         PVOID_cfINT(N,A,B,X,Y,Z)
01312 #define         STRING_cfINT(N,A,B,X,Y,Z)         PVOID_cfINT(N,A,B,X,Y,Z)
01313 #define        STRINGV_cfINT(N,A,B,X,Y,Z)         PVOID_cfINT(N,A,B,X,Y,Z)
01314 #define        PSTRING_cfINT(N,A,B,X,Y,Z)         PVOID_cfINT(N,A,B,X,Y,Z)
01315 #define       PSTRINGV_cfINT(N,A,B,X,Y,Z)         PVOID_cfINT(N,A,B,X,Y,Z)
01316 #define       PNSTRING_cfINT(N,A,B,X,Y,Z)         PVOID_cfINT(N,A,B,X,Y,Z)
01317 #define       PPSTRING_cfINT(N,A,B,X,Y,Z)         PVOID_cfINT(N,A,B,X,Y,Z)
01318 #define        ZTRINGV_cfINT(N,A,B,X,Y,Z)         PVOID_cfINT(N,A,B,X,Y,Z)
01319 #define       PZTRINGV_cfINT(N,A,B,X,Y,Z)         PVOID_cfINT(N,A,B,X,Y,Z)
01320 #define           CF_0_cfINT(N,A,B,X,Y,Z)
01321 
01322 
01323 #define   UCF(TN,I,C)  _SEP_(TN,C,COMMA) _Icf(2,U,TN,_(A,I),0)
01324 #define  UUCF(TN,I,C)  _SEP_(TN,C,COMMA) _SEP_(TN,1,I)
01325 #define UUUCF(TN,I,C)  _SEP_(TN,C,COLON) _Icf(2,U,TN,_(A,I),0)
01326 #define        INT_cfU(T,A) _(T,VVVVVVV_cfTYPE)   A
01327 #define       INTV_cfU(T,A) _(T,VVVVVV_cfTYPE)  * A
01328 #define      INTVV_cfU(T,A) _(T,VVVVV_cfTYPE)   * A
01329 #define     INTVVV_cfU(T,A) _(T,VVVV_cfTYPE)    * A
01330 #define    INTVVVV_cfU(T,A) _(T,VVV_cfTYPE)     * A
01331 #define   INTVVVVV_cfU(T,A) _(T,VV_cfTYPE)      * A
01332 #define  INTVVVVVV_cfU(T,A) _(T,V_cfTYPE)       * A
01333 #define INTVVVVVVV_cfU(T,A) _(T,_cfTYPE)        * A
01334 #define       PINT_cfU(T,A) _(T,_cfTYPE)        * A
01335 #define      PVOID_cfU(T,A) void  *A
01336 #define    ROUTINE_cfU(T,A) void (*A)(CF_NULL_PROTO)
01337 #define       VOID_cfU(T,A) void   A    /* Needed for C calls FORTRAN sub.s.  */
01338 #define     STRING_cfU(T,A) char  *A    /*            via VOID and wrapper.   */
01339 #define    STRINGV_cfU(T,A) char  *A
01340 #define    PSTRING_cfU(T,A) char  *A
01341 #define   PSTRINGV_cfU(T,A) char  *A
01342 #define    ZTRINGV_cfU(T,A) char  *A
01343 #define   PZTRINGV_cfU(T,A) char  *A
01344 
01345 /* VOID breaks U into U and UU. */
01346 #define       INT_cfUU(T,A) _(T,VVVVVVV_cfTYPE) A
01347 #define      VOID_cfUU(T,A)     /* Needed for FORTRAN calls C sub.s.  */
01348 #define    STRING_cfUU(T,A) char *A
01349 
01350 
01351 #define      BYTE_cfPU(A)   CFextern INTEGER_BYTE      FCALLSC_QUALIFIER A
01352 #define    DOUBLE_cfPU(A)   CFextern DOUBLE_PRECISION  FCALLSC_QUALIFIER A
01353 #if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT))
01354 #define     FLOAT_cfPU(A)   CFextern FORTRAN_REAL      FCALLSC_QUALIFIER A
01355 #else
01356 #define     FLOAT_cfPU(A)   CFextern FLOATFUNCTIONTYPE FCALLSC_QUALIFIER A
01357 #endif
01358 #define       INT_cfPU(A)   CFextern int   FCALLSC_QUALIFIER   A
01359 #define   LOGICAL_cfPU(A)   CFextern int   FCALLSC_QUALIFIER   A
01360 #define      LONG_cfPU(A)   CFextern long  FCALLSC_QUALIFIER   A
01361 #define     SHORT_cfPU(A)   CFextern short FCALLSC_QUALIFIER   A
01362 #define    STRING_cfPU(A)   CFextern void  FCALLSC_QUALIFIER   A
01363 #define      VOID_cfPU(A)   CFextern void  FCALLSC_QUALIFIER   A
01364 
01365 #define    BYTE_cfE INTEGER_BYTE     A0;
01366 #define  DOUBLE_cfE DOUBLE_PRECISION A0;
01367 #if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT))
01368 #define   FLOAT_cfE FORTRAN_REAL  A0;
01369 #else
01370 #define   FLOAT_cfE FORTRAN_REAL AA0;   FLOATFUNCTIONTYPE A0;
01371 #endif
01372 #define     INT_cfE int    A0;
01373 #define LOGICAL_cfE int    A0;
01374 #define    LONG_cfE long   A0;
01375 #define   SHORT_cfE short  A0;
01376 #define    VOID_cfE
01377 #ifdef vmsFortran
01378 #define  STRING_cfE static char AA0[1+MAX_LEN_FORTRAN_FUNCTION_STRING];        \
01379                        static fstring A0 =                                     \
01380              {MAX_LEN_FORTRAN_FUNCTION_STRING,DSC$K_DTYPE_T,DSC$K_CLASS_S,AA0};\
01381                memset(AA0, CFORTRAN_NON_CHAR, MAX_LEN_FORTRAN_FUNCTION_STRING);\
01382                                     *(AA0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0';
01383 #else
01384 #ifdef CRAYFortran
01385 #define  STRING_cfE static char AA0[1+MAX_LEN_FORTRAN_FUNCTION_STRING];        \
01386                    static _fcd A0; *(AA0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0';\
01387                 memset(AA0,CFORTRAN_NON_CHAR, MAX_LEN_FORTRAN_FUNCTION_STRING);\
01388                             A0 = _cptofcd(AA0,MAX_LEN_FORTRAN_FUNCTION_STRING);
01389 #else
01390 /* 'cc: SC3.0.1 13 Jul 1994' barfs on char A0[0x4FE+1]; 
01391  * char A0[0x4FE +1]; char A0[1+0x4FE]; are both OK.     */
01392 #define STRING_cfE static char A0[1+MAX_LEN_FORTRAN_FUNCTION_STRING];          \
01393                        memset(A0, CFORTRAN_NON_CHAR,                           \
01394                               MAX_LEN_FORTRAN_FUNCTION_STRING);                \
01395                        *(A0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0';
01396 #endif
01397 #endif
01398 /* ESTRING must use static char. array which is guaranteed to exist after
01399    function returns.                                                     */
01400 
01401 /* N.B.i) The diff. for 0 (Zero) and >=1 arguments.
01402        ii)That the following create an unmatched bracket, i.e. '(', which
01403           must of course be matched in the call.
01404        iii)Commas must be handled very carefully                         */
01405 #define    INT_cfGZ(T,UN,LN) A0=CFC_(UN,LN)(
01406 #define   VOID_cfGZ(T,UN,LN)    CFC_(UN,LN)(
01407 #ifdef vmsFortran
01408 #define STRING_cfGZ(T,UN,LN)    CFC_(UN,LN)(&A0
01409 #else
01410 #if defined(CRAYFortran) || defined(AbsoftUNIXFortran)
01411 #define STRING_cfGZ(T,UN,LN)    CFC_(UN,LN)( A0
01412 #else
01413 #define STRING_cfGZ(T,UN,LN)    CFC_(UN,LN)( A0,MAX_LEN_FORTRAN_FUNCTION_STRING
01414 #endif
01415 #endif
01416 
01417 #define     INT_cfG(T,UN,LN)    INT_cfGZ(T,UN,LN)
01418 #define    VOID_cfG(T,UN,LN)   VOID_cfGZ(T,UN,LN)
01419 #define  STRING_cfG(T,UN,LN) STRING_cfGZ(T,UN,LN),      /*, is only diff. from _cfG */
01420 
01421 #define    BYTEVVVVVVV_cfPP
01422 #define     INTVVVVVVV_cfPP     /* These complement FLOATVVVVVVV_cfPP. */
01423 #define  DOUBLEVVVVVVV_cfPP
01424 #define LOGICALVVVVVVV_cfPP
01425 #define    LONGVVVVVVV_cfPP
01426 #define   SHORTVVVVVVV_cfPP
01427 #define          PBYTE_cfPP
01428 #define           PINT_cfPP
01429 #define        PDOUBLE_cfPP
01430 #define       PLOGICAL_cfPP
01431 #define          PLONG_cfPP
01432 #define         PSHORT_cfPP
01433 #define         PFLOAT_cfPP FLOATVVVVVVV_cfPP
01434 
01435 #define BCF(TN,AN,C)        _SEP_(TN,C,COMMA) _Icf(2,B,TN,AN,0)
01436 #define        INT_cfB(T,A) (_(T,VVVVVVV_cfTYPE)) A
01437 #define       INTV_cfB(T,A)            A
01438 #define      INTVV_cfB(T,A)           (A)[0]
01439 #define     INTVVV_cfB(T,A)           (A)[0][0]
01440 #define    INTVVVV_cfB(T,A)           (A)[0][0][0]
01441 #define   INTVVVVV_cfB(T,A)           (A)[0][0][0][0]
01442 #define  INTVVVVVV_cfB(T,A)           (A)[0][0][0][0][0]
01443 #define INTVVVVVVV_cfB(T,A)           (A)[0][0][0][0][0][0]
01444 #define       PINT_cfB(T,A) _(T,_cfPP)&A
01445 #define     STRING_cfB(T,A) (char *)   A
01446 #define    STRINGV_cfB(T,A) (char *)   A
01447 #define    PSTRING_cfB(T,A) (char *)   A
01448 #define   PSTRINGV_cfB(T,A) (char *)   A
01449 #define      PVOID_cfB(T,A) (void *)   A
01450 #define    ROUTINE_cfB(T,A) (void(*)(CF_NULL_PROTO))A
01451 #define    ZTRINGV_cfB(T,A) (char *)   A
01452 #define   PZTRINGV_cfB(T,A) (char *)   A
01453 
01454 #define SCF(TN,NAME,I,A)    _(TN,_cfSTR)(3,S,NAME,I,A,0,0)
01455 #define  DEFAULT_cfS(M,I,A)
01456 #define  LOGICAL_cfS(M,I,A)
01457 #define PLOGICAL_cfS(M,I,A)
01458 #define   STRING_cfS(M,I,A) ,sizeof(A)
01459 #define  STRINGV_cfS(M,I,A) ,( (unsigned)0xFFFF*firstindexlength(A) \
01460                               +secondindexlength(A))
01461 #define  PSTRING_cfS(M,I,A) ,sizeof(A)
01462 #define PSTRINGV_cfS(M,I,A) STRINGV_cfS(M,I,A)
01463 #define  ZTRINGV_cfS(M,I,A)
01464 #define PZTRINGV_cfS(M,I,A)
01465 
01466 #define   HCF(TN,I)         _(TN,_cfSTR)(3,H,COMMA, H,_(C,I),0,0)
01467 #define  HHCF(TN,I)         _(TN,_cfSTR)(3,H,COMMA,HH,_(C,I),0,0)
01468 #define HHHCF(TN,I)         _(TN,_cfSTR)(3,H,COLON, H,_(C,I),0,0)
01469 #define  H_CF_SPECIAL       unsigned
01470 #define HH_CF_SPECIAL
01471 #define  DEFAULT_cfH(M,I,A)
01472 #define  LOGICAL_cfH(S,U,B)
01473 #define PLOGICAL_cfH(S,U,B)
01474 #define   STRING_cfH(S,U,B) _(A,S) _(U,_CF_SPECIAL) B
01475 #define  STRINGV_cfH(S,U,B) STRING_cfH(S,U,B)
01476 #define  PSTRING_cfH(S,U,B) STRING_cfH(S,U,B)
01477 #define PSTRINGV_cfH(S,U,B) STRING_cfH(S,U,B)
01478 #define PNSTRING_cfH(S,U,B) STRING_cfH(S,U,B)
01479 #define PPSTRING_cfH(S,U,B) STRING_cfH(S,U,B)
01480 #define  ZTRINGV_cfH(S,U,B)
01481 #define PZTRINGV_cfH(S,U,B)
01482 
01483 /* Need VOID_cfSTR because Absoft forced function types go through _cfSTR. */
01484 /* No spaces inside expansion. They screws up macro catenation kludge.     */
01485 #define           VOID_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01486 #define           BYTE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01487 #define         DOUBLE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01488 #define          FLOAT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01489 #define            INT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01490 #define        LOGICAL_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,LOGICAL,A,B,C,D,E)
01491 #define           LONG_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01492 #define          SHORT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01493 #define          BYTEV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01494 #define         BYTEVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01495 #define        BYTEVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01496 #define       BYTEVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01497 #define      BYTEVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01498 #define     BYTEVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01499 #define    BYTEVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01500 #define        DOUBLEV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01501 #define       DOUBLEVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01502 #define      DOUBLEVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01503 #define     DOUBLEVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01504 #define    DOUBLEVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01505 #define   DOUBLEVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01506 #define  DOUBLEVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01507 #define         FLOATV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01508 #define        FLOATVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01509 #define       FLOATVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01510 #define      FLOATVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01511 #define     FLOATVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01512 #define    FLOATVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01513 #define   FLOATVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01514 #define           INTV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01515 #define          INTVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01516 #define         INTVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01517 #define        INTVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01518 #define       INTVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01519 #define      INTVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01520 #define     INTVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01521 #define       LOGICALV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01522 #define      LOGICALVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01523 #define     LOGICALVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01524 #define    LOGICALVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01525 #define   LOGICALVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01526 #define  LOGICALVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01527 #define LOGICALVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01528 #define          LONGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01529 #define         LONGVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01530 #define        LONGVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01531 #define       LONGVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01532 #define      LONGVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01533 #define     LONGVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01534 #define    LONGVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01535 #define         SHORTV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01536 #define        SHORTVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01537 #define       SHORTVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01538 #define      SHORTVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01539 #define     SHORTVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01540 #define    SHORTVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01541 #define   SHORTVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01542 #define          PBYTE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01543 #define        PDOUBLE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01544 #define         PFLOAT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01545 #define           PINT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01546 #define       PLOGICAL_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PLOGICAL,A,B,C,D,E)
01547 #define          PLONG_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01548 #define         PSHORT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01549 #define         STRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,STRING,A,B,C,D,E)
01550 #define        PSTRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PSTRING,A,B,C,D,E)
01551 #define        STRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,STRINGV,A,B,C,D,E)
01552 #define       PSTRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PSTRINGV,A,B,C,D,E)
01553 #define       PNSTRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PNSTRING,A,B,C,D,E)
01554 #define       PPSTRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PPSTRING,A,B,C,D,E)
01555 #define          PVOID_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01556 #define        ROUTINE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01557 #define         SIMPLE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
01558 #define        ZTRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,ZTRINGV,A,B,C,D,E)
01559 #define       PZTRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PZTRINGV,A,B,C,D,E)
01560 #define           CF_0_cfSTR(N,T,A,B,C,D,E)
01561 
01562 /* See ACF table comments, which explain why CCF was split into two. */
01563 #define CCF(NAME,TN,I)     _(TN,_cfSTR)(5,C,NAME,I,_(A,I),_(B,I),_(C,I))
01564 #define  DEFAULT_cfC(M,I,A,B,C)
01565 #define  LOGICAL_cfC(M,I,A,B,C)  A=C2FLOGICAL( A);
01566 #define PLOGICAL_cfC(M,I,A,B,C) *A=C2FLOGICAL(*A);
01567 #ifdef vmsFortran
01568 #define   STRING_cfC(M,I,A,B,C) (B.clen=strlen(A),B.f.dsc$a_pointer=A,         \
01569         C==sizeof(char*)||C==(unsigned)(B.clen+1)?B.f.dsc$w_length=B.clen:     \
01570           (memset((A)+B.clen,' ',C-B.clen-1),A[B.f.dsc$w_length=C-1]='\0'));
01571       /* PSTRING_cfC to beware of array A which does not contain any \0.      */
01572 #define  PSTRING_cfC(M,I,A,B,C) (B.dsc$a_pointer=A, C==sizeof(char*) ?         \
01573              B.dsc$w_length=strlen(A):  (A[C-1]='\0',B.dsc$w_length=strlen(A), \
01574        memset((A)+B.dsc$w_length,' ',C-B.dsc$w_length-1), B.dsc$w_length=C-1));
01575 #else
01576 #define   STRING_cfC(M,I,A,B,C) (B.clen=strlen(A),                             \
01577                 C==sizeof(char*)||C==(unsigned)(B.clen+1)?B.flen=B.clen:       \
01578                         (memset((A)+B.clen,' ',C-B.clen-1),A[B.flen=C-1]='\0'));
01579 #define  PSTRING_cfC(M,I,A,B,C) (C==sizeof(char*)? B=strlen(A):                \
01580                     (A[C-1]='\0',B=strlen(A),memset((A)+B,' ',C-B-1),B=C-1));
01581 #endif
01582           /* For CRAYFortran for (P)STRINGV_cfC, B.fs is set, but irrelevant. */
01583 #define  STRINGV_cfC(M,I,A,B,C) \
01584         AATRINGV_cfA(    A,B,(C/0xFFFF)*(C%0xFFFF),C/0xFFFF,C%0xFFFF)
01585 #define PSTRINGV_cfC(M,I,A,B,C) \
01586        APATRINGV_cfA(    A,B,(C/0xFFFF)*(C%0xFFFF),C/0xFFFF,C%0xFFFF)
01587 #define  ZTRINGV_cfC(M,I,A,B,C) \
01588         AATRINGV_cfA(    A,B, (_3(M,_ELEMS_,I))*((_3(M,_ELEMLEN_,I))+1),       \
01589                               (_3(M,_ELEMS_,I)), (_3(M,_ELEMLEN_,I))+1   )
01590 #define PZTRINGV_cfC(M,I,A,B,C) \
01591        APATRINGV_cfA(    A,B, (_3(M,_ELEMS_,I))*((_3(M,_ELEMLEN_,I))+1),       \
01592                               (_3(M,_ELEMS_,I)), (_3(M,_ELEMLEN_,I))+1   )
01593 
01594 #define     BYTE_cfCCC(A,B) &A
01595 #define   DOUBLE_cfCCC(A,B) &A
01596 #if !defined(__CF__KnR)
01597 #define    FLOAT_cfCCC(A,B) &A
01598                                /* Although the VAX doesn't, at least the      */
01599 #else                           /* HP and K&R mips promote float arg.'s of     */
01600 #define    FLOAT_cfCCC(A,B) &B  /* unprototyped functions to double. Cannot    */
01601 #endif                          /* use A here to pass the argument to FORTRAN. */
01602 #define      INT_cfCCC(A,B) &A
01603 #define  LOGICAL_cfCCC(A,B) &A
01604 #define     LONG_cfCCC(A,B) &A
01605 #define    SHORT_cfCCC(A,B) &A
01606 #define    PBYTE_cfCCC(A,B)  A
01607 #define  PDOUBLE_cfCCC(A,B)  A
01608 #define   PFLOAT_cfCCC(A,B)  A
01609 #define     PINT_cfCCC(A,B)  A
01610 #define PLOGICAL_cfCCC(A,B)  B=A        /* B used to keep a common W table. */
01611 #define    PLONG_cfCCC(A,B)  A
01612 #define   PSHORT_cfCCC(A,B)  A
01613 
01614 #define CCCF(TN,I,M)           _SEP_(TN,M,COMMA) _Icf(3,CC,TN,_(A,I),_(B,I))
01615 #define        INT_cfCC(T,A,B) _(T,_cfCCC)(A,B)
01616 #define       INTV_cfCC(T,A,B)  A
01617 #define      INTVV_cfCC(T,A,B)  A
01618 #define     INTVVV_cfCC(T,A,B)  A
01619 #define    INTVVVV_cfCC(T,A,B)  A
01620 #define   INTVVVVV_cfCC(T,A,B)  A
01621 #define  INTVVVVVV_cfCC(T,A,B)  A
01622 #define INTVVVVVVV_cfCC(T,A,B)  A
01623 #define       PINT_cfCC(T,A,B) _(T,_cfCCC)(A,B)
01624 #define      PVOID_cfCC(T,A,B)  A
01625 #if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran)
01626 #define    ROUTINE_cfCC(T,A,B) &A
01627 #else
01628 #define    ROUTINE_cfCC(T,A,B)  A
01629 #endif
01630 #define     SIMPLE_cfCC(T,A,B)  A
01631 #ifdef vmsFortran
01632 #define     STRING_cfCC(T,A,B) &B.f
01633 #define    STRINGV_cfCC(T,A,B) &B
01634 #define    PSTRING_cfCC(T,A,B) &B
01635 #define   PSTRINGV_cfCC(T,A,B) &B
01636 #else
01637 #ifdef CRAYFortran
01638 #define     STRING_cfCC(T,A,B) _cptofcd(A,B.flen)
01639 #define    STRINGV_cfCC(T,A,B) _cptofcd(B.s,B.flen)
01640 #define    PSTRING_cfCC(T,A,B) _cptofcd(A,B)
01641 #define   PSTRINGV_cfCC(T,A,B) _cptofcd(A,B.flen)
01642 #else
01643 #define     STRING_cfCC(T,A,B)  A
01644 #define    STRINGV_cfCC(T,A,B)  B.fs
01645 #define    PSTRING_cfCC(T,A,B)  A
01646 #define   PSTRINGV_cfCC(T,A,B)  B.fs
01647 #endif
01648 #endif
01649 #define    ZTRINGV_cfCC(T,A,B)   STRINGV_cfCC(T,A,B)
01650 #define   PZTRINGV_cfCC(T,A,B)  PSTRINGV_cfCC(T,A,B)
01651 
01652 #define    BYTE_cfX  return A0;
01653 #define  DOUBLE_cfX  return A0;
01654 #if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT))
01655 #define   FLOAT_cfX  return A0;
01656 #else
01657 #define   FLOAT_cfX  ASSIGNFLOAT(AA0,A0); return AA0;
01658 #endif
01659 #define     INT_cfX  return A0;
01660 #define LOGICAL_cfX  return F2CLOGICAL(A0);
01661 #define    LONG_cfX  return A0;
01662 #define   SHORT_cfX  return A0;
01663 #define    VOID_cfX  return   ;
01664 #if defined(vmsFortran) || defined(CRAYFortran)
01665 #define  STRING_cfX  return kill_trailing(                                     \
01666                                       kill_trailing(AA0,CFORTRAN_NON_CHAR),' ');
01667 #else
01668 #define  STRING_cfX  return kill_trailing(                                     \
01669                                       kill_trailing( A0,CFORTRAN_NON_CHAR),' ');
01670 #endif
01671 
01672 #define CFFUN(NAME) _(__cf__,NAME)
01673 
01674 /* Note that we don't use LN here, but we keep it for consistency. */
01675 #define CCALLSFFUN0(UN,LN) CFFUN(UN)()
01676 
01677 #ifdef OLD_VAXC                 /* Allow %CC-I-PARAMNOTUSED. */
01678 #pragma standard
01679 #endif
01680 
01681 #define CCALLSFFUN1( UN,LN,T1,                        A1)         \
01682         CCALLSFFUN5 (UN,LN,T1,CF_0,CF_0,CF_0,CF_0,A1,0,0,0,0)
01683 #define CCALLSFFUN2( UN,LN,T1,T2,                     A1,A2)      \
01684         CCALLSFFUN5 (UN,LN,T1,T2,CF_0,CF_0,CF_0,A1,A2,0,0,0)
01685 #define CCALLSFFUN3( UN,LN,T1,T2,T3,                  A1,A2,A3)   \
01686         CCALLSFFUN5 (UN,LN,T1,T2,T3,CF_0,CF_0,A1,A2,A3,0,0)
01687 #define CCALLSFFUN4( UN,LN,T1,T2,T3,T4,               A1,A2,A3,A4)\
01688         CCALLSFFUN5 (UN,LN,T1,T2,T3,T4,CF_0,A1,A2,A3,A4,0)
01689 #define CCALLSFFUN5( UN,LN,T1,T2,T3,T4,T5,            A1,A2,A3,A4,A5)          \
01690         CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,0,0,0,0,0)
01691 #define CCALLSFFUN6( UN,LN,T1,T2,T3,T4,T5,T6,         A1,A2,A3,A4,A5,A6)       \
01692         CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,0,0,0,0)
01693 #define CCALLSFFUN7( UN,LN,T1,T2,T3,T4,T5,T6,T7,      A1,A2,A3,A4,A5,A6,A7)    \
01694         CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,0,0,0)
01695 #define CCALLSFFUN8( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,   A1,A2,A3,A4,A5,A6,A7,A8) \
01696         CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,0,0)
01697 #define CCALLSFFUN9( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,A1,A2,A3,A4,A5,A6,A7,A8,A9)\
01698         CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,0)
01699 #define CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA)\
01700         CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,0,0,0,0)
01701 #define CCALLSFFUN11(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB)\
01702         CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,0,0,0)
01703 #define CCALLSFFUN12(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC)\
01704         CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,0,0)
01705 #define CCALLSFFUN13(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD)\
01706         CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,0)
01707 
01708 #define CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE)\
01709 ((CFFUN(UN)(  BCF(T1,A1,0) BCF(T2,A2,1) BCF(T3,A3,1) BCF(T4,A4,1) BCF(T5,A5,1) \
01710               BCF(T6,A6,1) BCF(T7,A7,1) BCF(T8,A8,1) BCF(T9,A9,1) BCF(TA,AA,1) \
01711               BCF(TB,AB,1) BCF(TC,AC,1) BCF(TD,AD,1) BCF(TE,AE,1)              \
01712            SCF(T1,LN,1,A1) SCF(T2,LN,2,A2) SCF(T3,LN,3,A3) SCF(T4,LN,4,A4)     \
01713            SCF(T5,LN,5,A5) SCF(T6,LN,6,A6) SCF(T7,LN,7,A7) SCF(T8,LN,8,A8)     \
01714            SCF(T9,LN,9,A9) SCF(TA,LN,A,AA) SCF(TB,LN,B,AB) SCF(TC,LN,C,AC)     \
01715            SCF(TD,LN,D,AD))))
01716 
01717 /*  N.B. Create a separate function instead of using (call function, function
01718 value here) because in order to create the variables needed for the input
01719 arg.'s which may be const.'s one has to do the creation within {}, but these
01720 can never be placed within ()'s. Therefore one must create wrapper functions.
01721 gcc, on the other hand may be able to avoid the wrapper functions. */
01722 
01723 /* Prototypes are needed to correctly handle the value returned correctly. N.B.
01724 Can only have prototype arg.'s with difficulty, a la G... table since FORTRAN
01725 functions returning strings have extra arg.'s. Don't bother, since this only
01726 causes a compiler warning to come up when one uses FCALLSCFUNn and CCALLSFFUNn
01727 for the same function in the same source code. Something done by the experts in
01728 debugging only.*/
01729 
01730 #define PROTOCCALLSFFUN0(F,UN,LN)                                              \
01731 _(F,_cfPU)( CFC_(UN,LN))(CF_NULL_PROTO);                                       \
01732 static _Icf(2,U,F,CFFUN(UN),0)() {_(F,_cfE) _Icf(3,GZ,F,UN,LN) ABSOFT_cf1(F));_(F,_cfX)}
01733 
01734 #define PROTOCCALLSFFUN1( T0,UN,LN,T1)                                         \
01735         PROTOCCALLSFFUN5 (T0,UN,LN,T1,CF_0,CF_0,CF_0,CF_0)
01736 #define PROTOCCALLSFFUN2( T0,UN,LN,T1,T2)                                      \
01737         PROTOCCALLSFFUN5 (T0,UN,LN,T1,T2,CF_0,CF_0,CF_0)
01738 #define PROTOCCALLSFFUN3( T0,UN,LN,T1,T2,T3)                                   \
01739         PROTOCCALLSFFUN5 (T0,UN,LN,T1,T2,T3,CF_0,CF_0)
01740 #define PROTOCCALLSFFUN4( T0,UN,LN,T1,T2,T3,T4)                                \
01741         PROTOCCALLSFFUN5 (T0,UN,LN,T1,T2,T3,T4,CF_0)
01742 #define PROTOCCALLSFFUN5( T0,UN,LN,T1,T2,T3,T4,T5)                             \
01743         PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0)
01744 #define PROTOCCALLSFFUN6( T0,UN,LN,T1,T2,T3,T4,T5,T6)                          \
01745         PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0)
01746 #define PROTOCCALLSFFUN7( T0,UN,LN,T1,T2,T3,T4,T5,T6,T7)                       \
01747         PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0)
01748 #define PROTOCCALLSFFUN8( T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8)                    \
01749         PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0)
01750 #define PROTOCCALLSFFUN9( T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9)                 \
01751         PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0)
01752 #define PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA)              \
01753         PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0)
01754 #define PROTOCCALLSFFUN11(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB)           \
01755         PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0)
01756 #define PROTOCCALLSFFUN12(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC)        \
01757         PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0)
01758 #define PROTOCCALLSFFUN13(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD)     \
01759         PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0)
01760 
01761 /* HP/UX 9.01 cc requires the blank between '_Icf(3,G,T0,UN,LN) CCCF(T1,1,0)' */
01762 
01763 #ifndef __CF__KnR
01764 #define PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)  \
01765  _(T0,_cfPU)(CFC_(UN,LN))(CF_NULL_PROTO); static _Icf(2,U,T0,CFFUN(UN),0)(     \
01766    CFARGT14FS(UCF,HCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) )          \
01767 {       CFARGT14S(VCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)    _(T0,_cfE) \
01768  CCF(LN,T1,1) CCF(LN,T2,2) CCF(LN,T3,3) CCF(LN,T4,4) CCF(LN,T5,5)              \
01769  CCF(LN,T6,6) CCF(LN,T7,7) CCF(LN,T8,8) CCF(LN,T9,9) CCF(LN,TA,A)              \
01770  CCF(LN,TB,B) CCF(LN,TC,C) CCF(LN,TD,D) CCF(LN,TE,E)        _Icf(3,G,T0,UN,LN) \
01771  CFARGT14(CCCF,JCF,ABSOFT_cf1(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)); \
01772  WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5)              \
01773  WCF(T6,A6,6) WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,AA,A)              \
01774  WCF(TB,AB,B) WCF(TC,AC,C) WCF(TD,AD,D) WCF(TE,AE,E) _(T0,_cfX)}
01775 #else
01776 #define PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)  \
01777  _(T0,_cfPU)(CFC_(UN,LN))(CF_NULL_PROTO); static _Icf(2,U,T0,CFFUN(UN),0)(     \
01778    CFARGT14FS(UUCF,HHCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) )        \
01779  CFARGT14FS(UUUCF,HHHCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) ;        \
01780 {       CFARGT14S(VCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)    _(T0,_cfE) \
01781  CCF(LN,T1,1) CCF(LN,T2,2) CCF(LN,T3,3) CCF(LN,T4,4) CCF(LN,T5,5)              \
01782  CCF(LN,T6,6) CCF(LN,T7,7) CCF(LN,T8,8) CCF(LN,T9,9) CCF(LN,TA,A)              \
01783  CCF(LN,TB,B) CCF(LN,TC,C) CCF(LN,TD,D) CCF(LN,TE,E)        _Icf(3,G,T0,UN,LN) \
01784  CFARGT14(CCCF,JCF,ABSOFT_cf1(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)); \
01785  WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5)              \
01786  WCF(T6,A6,6) WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,AA,A)              \
01787  WCF(TB,AB,B) WCF(TC,AC,C) WCF(TD,AD,D) WCF(TE,AE,E) _(T0,_cfX)}
01788 #endif
01789 
01790 /*-------------------------------------------------------------------------*/
01791 
01792 /*               UTILITIES FOR FORTRAN TO CALL C ROUTINES                  */
01793 
01794 #ifdef OLD_VAXC                 /* Prevent %CC-I-PARAMNOTUSED. */
01795 #pragma nostandard
01796 #endif
01797 
01798 #if defined(vmsFortran) || defined(CRAYFortran)
01799 #define   DCF(TN,I)
01800 #define  DDCF(TN,I)
01801 #define DDDCF(TN,I)
01802 #else
01803 #define   DCF(TN,I)          HCF(TN,I)
01804 #define  DDCF(TN,I)         HHCF(TN,I)
01805 #define DDDCF(TN,I)        HHHCF(TN,I)
01806 #endif
01807 
01808 #define QCF(TN,I)       _(TN,_cfSTR)(1,Q,_(B,I), 0,0,0,0)
01809 #define  DEFAULT_cfQ(B)
01810 #define  LOGICAL_cfQ(B)
01811 #define PLOGICAL_cfQ(B)
01812 #define  STRINGV_cfQ(B) char *B; unsigned int _(B,N);
01813 #define   STRING_cfQ(B) char *B=NULL;
01814 #define  PSTRING_cfQ(B) char *B=NULL;
01815 #define PSTRINGV_cfQ(B) STRINGV_cfQ(B)
01816 #define PNSTRING_cfQ(B) char *B=NULL;
01817 #define PPSTRING_cfQ(B)
01818 
01819 #ifdef     __sgi                /* Else SGI gives warning 182 contrary to its C LRM A.17.7 */
01820 #define ROUTINE_orig    *(void**)&
01821 #else
01822 #define ROUTINE_orig     (void *)
01823 #endif
01824 
01825 #define ROUTINE_1     ROUTINE_orig
01826 #define ROUTINE_2     ROUTINE_orig
01827 #define ROUTINE_3     ROUTINE_orig
01828 #define ROUTINE_4     ROUTINE_orig
01829 #define ROUTINE_5     ROUTINE_orig
01830 #define ROUTINE_6     ROUTINE_orig
01831 #define ROUTINE_7     ROUTINE_orig
01832 #define ROUTINE_8     ROUTINE_orig
01833 #define ROUTINE_9     ROUTINE_orig
01834 #define ROUTINE_10    ROUTINE_orig
01835 #define ROUTINE_11    ROUTINE_orig
01836 #define ROUTINE_12    ROUTINE_orig
01837 #define ROUTINE_13    ROUTINE_orig
01838 #define ROUTINE_14    ROUTINE_orig
01839 
01840 #define TCF(NAME,TN,I,M)              _SEP_(TN,M,COMMA) _(TN,_cfT)(NAME,I,_(A,I),_(B,I),_(C,I))
01841 #define           BYTE_cfT(M,I,A,B,D) *A
01842 #define         DOUBLE_cfT(M,I,A,B,D) *A
01843 #define          FLOAT_cfT(M,I,A,B,D) *A
01844 #define            INT_cfT(M,I,A,B,D) *A
01845 #define        LOGICAL_cfT(M,I,A,B,D)  F2CLOGICAL(*A)
01846 #define           LONG_cfT(M,I,A,B,D) *A
01847 #define          SHORT_cfT(M,I,A,B,D) *A
01848 #define          BYTEV_cfT(M,I,A,B,D)  A
01849 #define        DOUBLEV_cfT(M,I,A,B,D)  A
01850 #define         FLOATV_cfT(M,I,A,B,D)  VOIDP A
01851 #define           INTV_cfT(M,I,A,B,D)  A
01852 #define       LOGICALV_cfT(M,I,A,B,D)  A
01853 #define          LONGV_cfT(M,I,A,B,D)  A
01854 #define         SHORTV_cfT(M,I,A,B,D)  A
01855 #define         BYTEVV_cfT(M,I,A,B,D)  (void *)A        /* We have to cast to void *, */
01856 #define        BYTEVVV_cfT(M,I,A,B,D)  (void *)A        /* since we don't know the   */
01857 #define       BYTEVVVV_cfT(M,I,A,B,D)  (void *)A        /* dimensions of the array.  */
01858 #define      BYTEVVVVV_cfT(M,I,A,B,D)  (void *)A        /* i.e. Unfortunately, can't */
01859 #define     BYTEVVVVVV_cfT(M,I,A,B,D)  (void *)A        /* check that the type       */
01860 #define    BYTEVVVVVVV_cfT(M,I,A,B,D)  (void *)A        /* matches the prototype.    */
01861 #define       DOUBLEVV_cfT(M,I,A,B,D)  (void *)A
01862 #define      DOUBLEVVV_cfT(M,I,A,B,D)  (void *)A
01863 #define     DOUBLEVVVV_cfT(M,I,A,B,D)  (void *)A
01864 #define    DOUBLEVVVVV_cfT(M,I,A,B,D)  (void *)A
01865 #define   DOUBLEVVVVVV_cfT(M,I,A,B,D)  (void *)A
01866 #define  DOUBLEVVVVVVV_cfT(M,I,A,B,D)  (void *)A
01867 #define        FLOATVV_cfT(M,I,A,B,D)  (void *)A
01868 #define       FLOATVVV_cfT(M,I,A,B,D)  (void *)A
01869 #define      FLOATVVVV_cfT(M,I,A,B,D)  (void *)A
01870 #define     FLOATVVVVV_cfT(M,I,A,B,D)  (void *)A
01871 #define    FLOATVVVVVV_cfT(M,I,A,B,D)  (void *)A
01872 #define   FLOATVVVVVVV_cfT(M,I,A,B,D)  (void *)A
01873 #define          INTVV_cfT(M,I,A,B,D)  (void *)A
01874 #define         INTVVV_cfT(M,I,A,B,D)  (void *)A
01875 #define        INTVVVV_cfT(M,I,A,B,D)  (void *)A
01876 #define       INTVVVVV_cfT(M,I,A,B,D)  (void *)A
01877 #define      INTVVVVVV_cfT(M,I,A,B,D)  (void *)A
01878 #define     INTVVVVVVV_cfT(M,I,A,B,D)  (void *)A
01879 #define      LOGICALVV_cfT(M,I,A,B,D)  (void *)A
01880 #define     LOGICALVVV_cfT(M,I,A,B,D)  (void *)A
01881 #define    LOGICALVVVV_cfT(M,I,A,B,D)  (void *)A
01882 #define   LOGICALVVVVV_cfT(M,I,A,B,D)  (void *)A
01883 #define  LOGICALVVVVVV_cfT(M,I,A,B,D)  (void *)A
01884 #define LOGICALVVVVVVV_cfT(M,I,A,B,D)  (void *)A
01885 #define         LONGVV_cfT(M,I,A,B,D)  (void *)A
01886 #define        LONGVVV_cfT(M,I,A,B,D)  (void *)A
01887 #define       LONGVVVV_cfT(M,I,A,B,D)  (void *)A
01888 #define      LONGVVVVV_cfT(M,I,A,B,D)  (void *)A
01889 #define     LONGVVVVVV_cfT(M,I,A,B,D)  (void *)A
01890 #define    LONGVVVVVVV_cfT(M,I,A,B,D)  (void *)A
01891 #define        SHORTVV_cfT(M,I,A,B,D)  (void *)A
01892 #define       SHORTVVV_cfT(M,I,A,B,D)  (void *)A
01893 #define      SHORTVVVV_cfT(M,I,A,B,D)  (void *)A
01894 #define     SHORTVVVVV_cfT(M,I,A,B,D)  (void *)A
01895 #define    SHORTVVVVVV_cfT(M,I,A,B,D)  (void *)A
01896 #define   SHORTVVVVVVV_cfT(M,I,A,B,D)  (void *)A
01897 #define          PBYTE_cfT(M,I,A,B,D)  A
01898 #define        PDOUBLE_cfT(M,I,A,B,D)  A
01899 #define         PFLOAT_cfT(M,I,A,B,D)  VOIDP A
01900 #define           PINT_cfT(M,I,A,B,D)  A
01901 #define       PLOGICAL_cfT(M,I,A,B,D)  ((*A=F2CLOGICAL(*A)),A)
01902 #define          PLONG_cfT(M,I,A,B,D)  A
01903 #define         PSHORT_cfT(M,I,A,B,D)  A
01904 #define          PVOID_cfT(M,I,A,B,D)  A
01905 #if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran)
01906 #define        ROUTINE_cfT(M,I,A,B,D)  _(ROUTINE_,I)  (*A)
01907 #else
01908 #define        ROUTINE_cfT(M,I,A,B,D)  _(ROUTINE_,I)    A
01909 #endif
01910 /* A == pointer to the characters
01911    D == length of the string, or of an element in an array of strings
01912    E == number of elements in an array of strings                             */
01913 #define TTSTR(    A,B,D)                                                       \
01914            ((B=(char*)malloc(D+1))[D]='\0', memcpy(B,A,D), kill_trailing(B,' '))
01915 #define TTTTSTR(  A,B,D)   (!(D<4||A[0]||A[1]||A[2]||A[3]))?NULL:              \
01916                             memchr(A,'\0',D)                 ?A   : TTSTR(A,B,D)
01917 #define TTTTSTRV( A,B,D,E) (_(B,N)=E,B=(char*)malloc(_(B,N)*(D+1)), (void *)   \
01918   vkill_trailing(f2cstrv(A,B,D+1, _(B,N)*(D+1)), D+1,_(B,N)*(D+1),' '))
01919 #ifdef vmsFortran
01920 #define         STRING_cfT(M,I,A,B,D)  TTTTSTR( A->dsc$a_pointer,B,A->dsc$w_length)
01921 #define        STRINGV_cfT(M,I,A,B,D)  TTTTSTRV(A->dsc$a_pointer, B,           \
01922                                              A->dsc$w_length , A->dsc$l_m[0])
01923 #define        PSTRING_cfT(M,I,A,B,D)    TTSTR( A->dsc$a_pointer,B,A->dsc$w_length)
01924 #define       PPSTRING_cfT(M,I,A,B,D)           A->dsc$a_pointer
01925 #else
01926 #ifdef CRAYFortran
01927 #define         STRING_cfT(M,I,A,B,D)  TTTTSTR( _fcdtocp(A),B,_fcdlen(A))
01928 #define        STRINGV_cfT(M,I,A,B,D)  TTTTSTRV(_fcdtocp(A),B,_fcdlen(A),      \
01929                               num_elem(_fcdtocp(A),_fcdlen(A),_3(M,_STRV_A,I)))
01930 #define        PSTRING_cfT(M,I,A,B,D)    TTSTR( _fcdtocp(A),B,_fcdlen(A))
01931 #define       PPSTRING_cfT(M,I,A,B,D)           _fcdtocp(A)
01932 #else
01933 #define         STRING_cfT(M,I,A,B,D)  TTTTSTR( A,B,D)
01934 #define        STRINGV_cfT(M,I,A,B,D)  TTTTSTRV(A,B,D, num_elem(A,D,_3(M,_STRV_A,I)))
01935 #define        PSTRING_cfT(M,I,A,B,D)    TTSTR( A,B,D)
01936 #define       PPSTRING_cfT(M,I,A,B,D)           A
01937 #endif
01938 #endif
01939 #define       PNSTRING_cfT(M,I,A,B,D)    STRING_cfT(M,I,A,B,D)
01940 #define       PSTRINGV_cfT(M,I,A,B,D)   STRINGV_cfT(M,I,A,B,D)
01941 #define           CF_0_cfT(M,I,A,B,D)
01942 
01943 #define RCF(TN,I)           _(TN,_cfSTR)(3,R,_(A,I),_(B,I),_(C,I),0,0)
01944 #define  DEFAULT_cfR(A,B,D)
01945 #define  LOGICAL_cfR(A,B,D)
01946 #define PLOGICAL_cfR(A,B,D) *A=C2FLOGICAL(*A);
01947 #define   STRING_cfR(A,B,D) if (B) free(B);
01948 #define  STRINGV_cfR(A,B,D) free(B);
01949 /* A and D as defined above for TSTRING(V) */
01950 #define RRRRPSTR( A,B,D)    if (B) memcpy(A,B, _cfMIN(strlen(B),D)),           \
01951                   (D>strlen(B)?memset(A+strlen(B),' ', D-strlen(B)):0), free(B);
01952 #define RRRRPSTRV(A,B,D)    c2fstrv(B,A,D+1,(D+1)*_(B,N)), free(B);
01953 #ifdef vmsFortran
01954 #define  PSTRING_cfR(A,B,D) RRRRPSTR( A->dsc$a_pointer,B,A->dsc$w_length)
01955 #define PSTRINGV_cfR(A,B,D) RRRRPSTRV(A->dsc$a_pointer,B,A->dsc$w_length)
01956 #else
01957 #ifdef CRAYFortran
01958 #define  PSTRING_cfR(A,B,D) RRRRPSTR( _fcdtocp(A),B,_fcdlen(A))
01959 #define PSTRINGV_cfR(A,B,D) RRRRPSTRV(_fcdtocp(A),B,_fcdlen(A))
01960 #else
01961 #define  PSTRING_cfR(A,B,D) RRRRPSTR( A,B,D)
01962 #define PSTRINGV_cfR(A,B,D) RRRRPSTRV(A,B,D)
01963 #endif
01964 #endif
01965 #define PNSTRING_cfR(A,B,D) PSTRING_cfR(A,B,D)
01966 #define PPSTRING_cfR(A,B,D)
01967 
01968 #define    BYTE_cfFZ(UN,LN) INTEGER_BYTE     FCALLSC_QUALIFIER fcallsc(UN,LN)(
01969 #define  DOUBLE_cfFZ(UN,LN) DOUBLE_PRECISION FCALLSC_QUALIFIER fcallsc(UN,LN)(
01970 #define     INT_cfFZ(UN,LN) int   FCALLSC_QUALIFIER fcallsc(UN,LN)(
01971 #define LOGICAL_cfFZ(UN,LN) int   FCALLSC_QUALIFIER fcallsc(UN,LN)(
01972 #define    LONG_cfFZ(UN,LN) long  FCALLSC_QUALIFIER fcallsc(UN,LN)(
01973 #define   SHORT_cfFZ(UN,LN) short FCALLSC_QUALIFIER fcallsc(UN,LN)(
01974 #define    VOID_cfFZ(UN,LN) void  FCALLSC_QUALIFIER fcallsc(UN,LN)(
01975 #ifndef __CF__KnR
01976 /* The void is req'd by the Apollo, to make this an ANSI function declaration.
01977    The Apollo promotes K&R float functions to double. */
01978 #define   FLOAT_cfFZ(UN,LN) FORTRAN_REAL FCALLSC_QUALIFIER fcallsc(UN,LN)(void
01979 #ifdef vmsFortran
01980 #define  STRING_cfFZ(UN,LN) void  FCALLSC_QUALIFIER fcallsc(UN,LN)(fstring *AS
01981 #else
01982 #ifdef CRAYFortran
01983 #define  STRING_cfFZ(UN,LN) void  FCALLSC_QUALIFIER fcallsc(UN,LN)(_fcd     AS
01984 #else
01985 #if  defined(AbsoftUNIXFortran)
01986 #define  STRING_cfFZ(UN,LN) void  FCALLSC_QUALIFIER fcallsc(UN,LN)(char    *AS
01987 #else
01988 #define  STRING_cfFZ(UN,LN) void  FCALLSC_QUALIFIER fcallsc(UN,LN)(char    *AS, unsigned D0
01989 #endif
01990 #endif
01991 #endif
01992 #else
01993 #if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT))
01994 #define   FLOAT_cfFZ(UN,LN) FORTRAN_REAL      FCALLSC_QUALIFIER fcallsc(UN,LN)(
01995 #else
01996 #define   FLOAT_cfFZ(UN,LN) FLOATFUNCTIONTYPE FCALLSC_QUALIFIER fcallsc(UN,LN)(
01997 #endif
01998 #if defined(vmsFortran) || defined(CRAYFortran) || defined(AbsoftUNIXFortran)
01999 #define  STRING_cfFZ(UN,LN) void  FCALLSC_QUALIFIER fcallsc(UN,LN)(AS
02000 #else
02001 #define  STRING_cfFZ(UN,LN) void  FCALLSC_QUALIFIER fcallsc(UN,LN)(AS, D0
02002 #endif
02003 #endif
02004 
02005 #define    BYTE_cfF(UN,LN)     BYTE_cfFZ(UN,LN)
02006 #define  DOUBLE_cfF(UN,LN)   DOUBLE_cfFZ(UN,LN)
02007 #ifndef __CF_KnR
02008 #define   FLOAT_cfF(UN,LN)  FORTRAN_REAL FCALLSC_QUALIFIER fcallsc(UN,LN)(
02009 #else
02010 #define   FLOAT_cfF(UN,LN)    FLOAT_cfFZ(UN,LN)
02011 #endif
02012 #define     INT_cfF(UN,LN)      INT_cfFZ(UN,LN)
02013 #define LOGICAL_cfF(UN,LN)  LOGICAL_cfFZ(UN,LN)
02014 #define    LONG_cfF(UN,LN)     LONG_cfFZ(UN,LN)
02015 #define   SHORT_cfF(UN,LN)    SHORT_cfFZ(UN,LN)
02016 #define    VOID_cfF(UN,LN)     VOID_cfFZ(UN,LN)
02017 #define  STRING_cfF(UN,LN)   STRING_cfFZ(UN,LN),
02018 
02019 #define     INT_cfFF
02020 #define    VOID_cfFF
02021 #ifdef vmsFortran
02022 #define  STRING_cfFF           fstring *AS;
02023 #else
02024 #ifdef CRAYFortran
02025 #define  STRING_cfFF           _fcd     AS;
02026 #else
02027 #define  STRING_cfFF           char    *AS; unsigned D0;
02028 #endif
02029 #endif
02030 
02031 #define     INT_cfL            A0=
02032 #define  STRING_cfL            A0=
02033 #define    VOID_cfL
02034 
02035 #define    INT_cfK
02036 #define   VOID_cfK
02037 /* KSTRING copies the string into the position provided by the caller. */
02038 #ifdef vmsFortran
02039 #define STRING_cfK                                                             \
02040  memcpy(AS->dsc$a_pointer,A0,_cfMIN(AS->dsc$w_length,(A0==NULL?0:strlen(A0))));\
02041  AS->dsc$w_length>(A0==NULL?0:strlen(A0))?                                     \
02042   memset(AS->dsc$a_pointer+(A0==NULL?0:strlen(A0)),' ',                        \
02043          AS->dsc$w_length-(A0==NULL?0:strlen(A0))):0;
02044 #else
02045 #ifdef CRAYFortran
02046 #define STRING_cfK                                                             \
02047  memcpy(_fcdtocp(AS),A0, _cfMIN(_fcdlen(AS),(A0==NULL?0:strlen(A0))) );        \
02048  _fcdlen(AS)>(A0==NULL?0:strlen(A0))?                                          \
02049   memset(_fcdtocp(AS)+(A0==NULL?0:strlen(A0)),' ',                             \
02050          _fcdlen(AS)-(A0==NULL?0:strlen(A0))):0;
02051 #else
02052 #define STRING_cfK         memcpy(AS,A0, _cfMIN(D0,(A0==NULL?0:strlen(A0))) ); \
02053                  D0>(A0==NULL?0:strlen(A0))?memset(AS+(A0==NULL?0:strlen(A0)), \
02054                                             ' ', D0-(A0==NULL?0:strlen(A0))):0;
02055 #endif
02056 #endif
02057 
02058 /* Note that K.. and I.. can't be combined since K.. has to access data before
02059 R.., in order for functions returning strings which are also passed in as
02060 arguments to work correctly. Note that R.. frees and hence may corrupt the
02061 string. */
02062 #define    BYTE_cfI  return A0;
02063 #define  DOUBLE_cfI  return A0;
02064 #if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT))
02065 #define   FLOAT_cfI  return A0;
02066 #else
02067 #define   FLOAT_cfI  RETURNFLOAT(A0);
02068 #endif
02069 #define     INT_cfI  return A0;
02070 #ifdef hpuxFortran800
02071 /* Incredibly, functions must return true as 1, elsewhere .true.==0x01000000. */
02072 #define LOGICAL_cfI  return ((A0)?1:0);
02073 #else
02074 #define LOGICAL_cfI  return C2FLOGICAL(A0);
02075 #endif
02076 #define    LONG_cfI  return A0;
02077 #define   SHORT_cfI  return A0;
02078 #define  STRING_cfI  return   ;
02079 #define    VOID_cfI  return   ;
02080 
02081 #ifdef OLD_VAXC                 /* Allow %CC-I-PARAMNOTUSED. */
02082 #pragma standard
02083 #endif
02084 
02085 #define FCALLSCSUB0( CN,UN,LN)             FCALLSCFUN0(VOID,CN,UN,LN)
02086 #define FCALLSCSUB1( CN,UN,LN,T1)          FCALLSCFUN1(VOID,CN,UN,LN,T1)
02087 #define FCALLSCSUB2( CN,UN,LN,T1,T2)       FCALLSCFUN2(VOID,CN,UN,LN,T1,T2)
02088 #define FCALLSCSUB3( CN,UN,LN,T1,T2,T3)    FCALLSCFUN3(VOID,CN,UN,LN,T1,T2,T3)
02089 #define FCALLSCSUB4( CN,UN,LN,T1,T2,T3,T4) \
02090     FCALLSCFUN4(VOID,CN,UN,LN,T1,T2,T3,T4)
02091 #define FCALLSCSUB5( CN,UN,LN,T1,T2,T3,T4,T5) \
02092     FCALLSCFUN5(VOID,CN,UN,LN,T1,T2,T3,T4,T5)
02093 #define FCALLSCSUB6( CN,UN,LN,T1,T2,T3,T4,T5,T6) \
02094     FCALLSCFUN6(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6)
02095 #define FCALLSCSUB7( CN,UN,LN,T1,T2,T3,T4,T5,T6,T7) \
02096     FCALLSCFUN7(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7)
02097 #define FCALLSCSUB8( CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \
02098     FCALLSCFUN8(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8)
02099 #define FCALLSCSUB9( CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \
02100     FCALLSCFUN9(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9)
02101 #define FCALLSCSUB10(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \
02102    FCALLSCFUN10(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA)
02103 #define FCALLSCSUB11(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \
02104    FCALLSCFUN11(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB)
02105 #define FCALLSCSUB12(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \
02106    FCALLSCFUN12(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC)
02107 #define FCALLSCSUB13(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \
02108    FCALLSCFUN13(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD)
02109 #define FCALLSCSUB14(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
02110    FCALLSCFUN14(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
02111 
02112 #define FCALLSCFUN1( T0,CN,UN,LN,T1) \
02113         FCALLSCFUN5 (T0,CN,UN,LN,T1,CF_0,CF_0,CF_0,CF_0)
02114 #define FCALLSCFUN2( T0,CN,UN,LN,T1,T2) \
02115         FCALLSCFUN5 (T0,CN,UN,LN,T1,T2,CF_0,CF_0,CF_0)
02116 #define FCALLSCFUN3( T0,CN,UN,LN,T1,T2,T3) \
02117         FCALLSCFUN5 (T0,CN,UN,LN,T1,T2,T3,CF_0,CF_0)
02118 #define FCALLSCFUN4( T0,CN,UN,LN,T1,T2,T3,T4) \
02119         FCALLSCFUN5 (T0,CN,UN,LN,T1,T2,T3,T4,CF_0)
02120 #define FCALLSCFUN5( T0,CN,UN,LN,T1,T2,T3,T4,T5) \
02121         FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0)
02122 #define FCALLSCFUN6( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6) \
02123         FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0)
02124 #define FCALLSCFUN7( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7) \
02125         FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0)
02126 #define FCALLSCFUN8( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \
02127         FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0)
02128 #define FCALLSCFUN9( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \
02129         FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0)
02130 #define FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \
02131         FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0)
02132 #define FCALLSCFUN11(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \
02133         FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0)
02134 #define FCALLSCFUN12(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \
02135         FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0)
02136 #define FCALLSCFUN13(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \
02137         FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0)
02138 
02139 #ifndef __CF__KnR
02140 #define FCALLSCFUN0(T0,CN,UN,LN) CFextern _(T0,_cfFZ)(UN,LN) ABSOFT_cf2(T0))   \
02141         {_Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN(); _Icf(0,K,T0,0,0) _(T0,_cfI)}
02142 
02143 #define FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)    \
02144                                  CFextern _(T0,_cfF)(UN,LN)                    \
02145    CFARGT14(NCF,DCF,ABSOFT_cf2(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)) \
02146  {                 CFARGT14S(QCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)    \
02147   _Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0)      CN(  TCF(LN,T1,1,0) TCF(LN,T2,2,1) \
02148     TCF(LN,T3,3,1) TCF(LN,T4,4,1) TCF(LN,T5,5,1) TCF(LN,T6,6,1) TCF(LN,T7,7,1) \
02149     TCF(LN,T8,8,1) TCF(LN,T9,9,1) TCF(LN,TA,A,1) TCF(LN,TB,B,1) TCF(LN,TC,C,1) \
02150     TCF(LN,TD,D,1) TCF(LN,TE,E,1) );                          _Icf(0,K,T0,0,0) \
02151                    CFARGT14S(RCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)  _(T0,_cfI) }
02152 #else
02153 #define FCALLSCFUN0(T0,CN,UN,LN) CFextern _(T0,_cfFZ)(UN,LN) ABSOFT_cf3(T0)) _Icf(0,FF,T0,0,0)\
02154         {_Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN(); _Icf(0,K,T0,0,0) _(T0,_cfI)}
02155 
02156 #define FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)    \
02157                                  CFextern _(T0,_cfF)(UN,LN)                    \
02158  CFARGT14(NNCF,DDCF,ABSOFT_cf3(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)) _Icf(0,FF,T0,0,0) \
02159        CFARGT14FS(NNNCF,DDDCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE);   \
02160  {                 CFARGT14S(QCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)    \
02161   _Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0)      CN(  TCF(LN,T1,1,0) TCF(LN,T2,2,1) \
02162     TCF(LN,T3,3,1) TCF(LN,T4,4,1) TCF(LN,T5,5,1) TCF(LN,T6,6,1) TCF(LN,T7,7,1) \
02163     TCF(LN,T8,8,1) TCF(LN,T9,9,1) TCF(LN,TA,A,1) TCF(LN,TB,B,1) TCF(LN,TC,C,1) \
02164     TCF(LN,TD,D,1) TCF(LN,TE,E,1) );                          _Icf(0,K,T0,0,0) \
02165                    CFARGT14S(RCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)  _(T0,_cfI)}
02166 #endif
02167 
02168 
02169 #endif                          /* __CFORTRAN_LOADED */

Midas DOC Version 3.0.0 ---- PSI Stefan Ritt ----
Contributions: Pierre-Andre Amaudruz - Sergio Ballestrero - Suzannah Daviel - Doxygen - Peter Green - Qing Gu - Greg Hackman - Gertjan Hofman - Paul Knowles - Exaos Lee - Rudi Meier - Glenn Moloney - Dave Morris - John M O'Donnell - Konstantin Olchanski - Renee Poutissou - Tamsen Schurman - Andreas Suter - Jan M.Wouters - Piotr Adam Zolnierczuk