include/root/cfortran.h

0001 /* cfortran.h  4.4 */
0002 /* http://www-zeus.desy.de/~burow/cfortran/                   */
0003 /* Burkhard Burow  burow@desy.de                 1990 - 2002. */
0004
0005 #ifndef __CFORTRAN_LOADED
0006 #define __CFORTRAN_LOADED
0007
0008 /*
0009    THIS FILE IS PROPERTY OF BURKHARD BUROW. IF YOU ARE USING THIS FILE YOU
0010    SHOULD ALSO HAVE ACCESS TO CFORTRAN.DOC WHICH PROVIDES TERMS FOR USING,
0011    MODIFYING, COPYING AND DISTRIBUTING THE CFORTRAN.H PACKAGE.
0012 */
0013
0014 /* The following modifications were made by the authors of CFITSIO or by me.
0015  * They are flagged below with CFITSIO, the author's initials, or KMCCARTY.
0016  * PDW = Peter Wilson
0017  * DM  = Doug Mink
0018  * LEB = Lee E Brotzman
0019  * MR  = Martin Reinecke
0020  * WDP = William D Pence
0021  * -- Kevin McCarty, for Debian (19 Dec. 2005) */
0022
0023 /*******
0024    Modifications:
0025       Oct 1997: Changed symbol name extname to appendus (PDW/HSTX)
0026                 (Conflicted with a common variable name in FTOOLS)
0027       Nov 1997: If g77Fortran defined, also define f2cFortran (PDW/HSTX)
0028       Feb 1998: Let VMS see the NUM_ELEMS code. Lets programs treat
0029                 single strings as vectors with single elements
0030       Nov 1999: If macintoxh defined, also define f2cfortran (for Mac OS-X)
0031       Apr 2000: If WIN32 defined, also define PowerStationFortran and
0032                 VISUAL_CPLUSPLUS (Visual C++)
0033       Jun 2000: If __GNUC__ and linux defined, also define f2cFortran
0034                 (linux/gcc environment detection)
0035       Apr 2002: If __CYGWIN__ is defined, also define f2cFortran
0036       Nov 2002: If __APPLE__ defined, also define f2cfortran (for Mac OS-X)
0037
0038       Nov 2003: If __INTEL_COMPILER or INTEL_COMPILER defined, also define
0039                 f2cFortran (KMCCARTY)
0040       Dec 2005: If f2cFortran is defined, enforce REAL functions in FORTRAN
0041                 returning "double" in C.  This was one of the items on
0042        Burkhard's TODO list. (KMCCARTY)
0043       Dec 2005: Modifications to support 8-byte integers. (MR)
0044       USE AT YOUR OWN RISK!
0045       Feb 2006  Added logic to typedef the symbol 'LONGLONG' to an appropriate
0046                 intrinsic 8-byte integer datatype  (WDP)
0047       Apr 2006: Modifications to support gfortran (and g77 with -fno-f2c flag)
0048                 since by default it returns "float" for FORTRAN REAL function.
0049                 (KMCCARTY)
0050       May 2008: Revert commenting out of "extern" in COMMON_BLOCK_DEF macro.
0051       Add braces around do-nothing ";" in 3 empty while blocks to
0052       get rid of compiler warnings.  Thanks to ROOT developers
0053       Jacek Holeczek and Rene Brun for these suggestions. (KMCCARTY)
0054  *******/
0055
0056 /*
0057   Avoid symbols already used by compilers and system *.h:
0058   __ - OSF1 zukal06 V3.0 347 alpha, cc -c -std1 cfortest.c
0059
0060 */
0061
0062 /*
0063    Determine what 8-byte integer data type is available.
0064   'long long' is now supported by most compilers, but older
0065   MS Visual C++ compilers before V7.0 use '__int64' instead. (WDP)
0066 */
0067
0068 #ifndef LONGLONG_TYPE   /* this may have been previously defined */
0069 #if defined(_MSC_VER)   /* Microsoft Visual C++ */
0070
0071 #if (_MSC_VER < 1300)   /* versions earlier than V7.0 do not have 'long long' */
0072     typedef __int64 LONGLONG;
0073 #else                   /* newer versions do support 'long long' */
0074     typedef long long LONGLONG;
0075 #endif
0076
0077 #else
0078     typedef long long LONGLONG;
0079 #endif
0080
0081 #define LONGLONG_TYPE
0082 #endif
0083
0084
0085 /* First prepare for the C compiler. */
0086
0087 #ifndef ANSI_C_preprocessor /* i.e. user can override. */
0088 #ifdef __CF__KnR
0089 #define ANSI_C_preprocessor 0
0090 #else
0091 #ifdef __STDC__
0092 #define ANSI_C_preprocessor 1
0093 #else
0094 #define _cfleft             1
0095 #define _cfright
0096 #define _cfleft_cfright     0
0097 #define ANSI_C_preprocessor _cfleft/**/_cfright
0098 #endif
0099 #endif
0100 #endif
0101
0102 #if ANSI_C_preprocessor
0103 #define _0(A,B)   A##B
0104 #define  _(A,B)   _0(A,B)  /* see cat,xcat of K&R ANSI C p. 231 */
0105 #define _2(A,B)   A##B     /* K&R ANSI C p.230: .. identifier is not replaced */
0106 #define _3(A,B,C) _(A,_(B,C))
0107 #else                      /* if it turns up again during rescanning.         */
0108 #define  _(A,B)   A/**/B
0109 #define _2(A,B)   A/**/B
0110 #define _3(A,B,C) A/**/B/**/C
0111 #endif
0112
0113 #if (defined(vax)&&defined(unix)) || (defined(__vax__)&&defined(__unix__))
0114 #define VAXUltrix
0115 #endif
0116
0117 #include <stdio.h>     /* NULL [in all machines stdio.h]                      */
0118 #include <string.h>    /* strlen, memset, memcpy, memchr.                     */
0119 #if !( defined(VAXUltrix) || defined(sun) || (defined(apollo)&&!defined(__STDCPP__)) )
0120 #include <stdlib.h>    /* malloc,free                                         */
0121 #else
0122 #include <malloc.h>    /* Had to be removed for DomainOS h105 10.4 sys5.3 425t*/
0123 #ifdef apollo
0124 #define __CF__APOLLO67 /* __STDCPP__ is in Apollo 6.8 (i.e. ANSI) and onwards */
0125 #endif
0126 #endif
0127
0128 #if !defined(__GNUC__) && !defined(__sun) && (defined(sun)||defined(VAXUltrix)||defined(lynx))
0129 #define __CF__KnR     /* Sun, LynxOS and VAX Ultrix cc only supports K&R.     */
0130                       /* Manually define __CF__KnR for HP if desired/required.*/
0131 #endif                /*       i.e. We will generate Kernighan and Ritchie C. */
0132 /* Note that you may define __CF__KnR before #include cfortran.h, in order to
0133 generate K&R C instead of the default ANSI C. The differences are mainly in the
0134 function prototypes and declarations. All machines, except the Apollo, work
0135 with either style. The Apollo's argument promotion rules require ANSI or use of
0136 the obsolete std_$call which we have not implemented here. Hence on the Apollo,
0137 only C calling FORTRAN subroutines will work using K&R style.*/
0138
0139
0140 /* Remainder of cfortran.h depends on the Fortran compiler. */
0141
0142 /* 11/29/2003 (KMCCARTY): add *INTEL_COMPILER symbols here */
0143 /* 04/05/2006 (KMCCARTY): add gFortran symbol here */
0144 #if defined(CLIPPERFortran) || defined(pgiFortran) || defined(__INTEL_COMPILER) || defined(INTEL_COMPILER) || defined(gFortran)
0145 #define f2cFortran
0146 #endif
0147
0148 /* VAX/VMS does not let us \-split long #if lines. */
0149 /* Split #if into 2 because some HP-UX can't handle long #if */
0150 #if !(defined(NAGf90Fortran)||defined(f2cFortran)||defined(hpuxFortran)||defined(apolloFortran)||defined(sunFortran)||defined(IBMR2Fortran)||defined(CRAYFortran))
0151 #if !(defined(mipsFortran)||defined(DECFortran)||defined(vmsFortran)||defined(CONVEXFortran)||defined(PowerStationFortran)||defined(AbsoftUNIXFortran)||defined(AbsoftProFortran)||defined(SXFortran))
0152 /* If no Fortran compiler is given, we choose one for the machines we know.   */
0153 #if defined(lynx) || defined(VAXUltrix)
0154 #define f2cFortran    /* Lynx:      Only support f2c at the moment.
0155                          VAXUltrix: f77 behaves like f2c.
0156                            Support f2c or f77 with gcc, vcc with f2c.
0157                            f77 with vcc works, missing link magic for f77 I/O.*/
0158 #endif
0159 /* 04/13/00 DM (CFITSIO): Add these lines for NT */
0160 /*   with PowerStationFortran and and Visual C++ */
0161 #if defined(WIN32) && !defined(__CYGWIN__)
0162 #define PowerStationFortran
0163 #define VISUAL_CPLUSPLUS
0164 #endif
0165 #if defined(g77Fortran)                        /* 11/03/97 PDW (CFITSIO) */
0166 #define f2cFortran
0167 #endif
0168 #if        defined(__CYGWIN__)                 /* 04/11/02 LEB (CFITSIO) */
0169 #define       f2cFortran
0170 #endif
0171 #if        defined(__GNUC__) && defined(linux) /* 06/21/00 PDW (CFITSIO) */
0172 #define       f2cFortran
0173 #endif
0174 #if defined(macintosh)                         /* 11/1999 (CFITSIO) */
0175 #define f2cFortran
0176 #endif
0177 #if defined(__APPLE__)                         /* 11/2002 (CFITSIO) */
0178 #define f2cFortran
0179 #endif
0180 #if defined(__FreeBSD__)
0181 #define  f2cFortran
0182 #endif
0183 #if defined(__hpux)             /* 921107: Use __hpux instead of __hp9000s300 */
0184 #define       hpuxFortran       /*         Should also allow hp9000s7/800 use.*/
0185 #endif
0186 #if       defined(apollo)
0187 #define           apolloFortran /* __CF__APOLLO67 also defines some behavior. */
0188 #endif
0189 #if          defined(sun) || defined(__sun)
0190 #define              sunFortran
0191 #endif
0192 #if       defined(_IBMR2)
0193 #define            IBMR2Fortran
0194 #endif
0195 #if        defined(_CRAY)
0196 #define             CRAYFortran /*       _CRAYT3E also defines some behavior. */
0197 #endif
0198 #if        defined(_SX)
0199 #define               SXFortran
0200 #endif
0201 #if         defined(mips) || defined(__mips)
0202 #define             mipsFortran
0203 #endif
0204 #if          defined(vms) || defined(__vms)
0205 #define              vmsFortran
0206 #endif
0207 #if      defined(__alpha) && defined(__unix__)
0208 #define              DECFortran
0209 #endif
0210 #if   defined(__convex__)
0211 #define           CONVEXFortran
0212 #endif
0213 #if   defined(VISUAL_CPLUSPLUS)
0214 #define     PowerStationFortran
0215 #endif
0216 #endif /* ...Fortran */
0217 #endif /* ...Fortran */
0218
0219 /* Split #if into 2 because some HP-UX can't handle long #if */
0220 #if !(defined(NAGf90Fortran)||defined(f2cFortran)||defined(hpuxFortran)||defined(apolloFortran)||defined(sunFortran)||defined(IBMR2Fortran)||defined(CRAYFortran))
0221 #if !(defined(mipsFortran)||defined(DECFortran)||defined(vmsFortran)||defined(CONVEXFortran)||defined(PowerStationFortran)||defined(AbsoftUNIXFortran)||defined(AbsoftProFortran)||defined(SXFortran))
0222 /* If your compiler barfs on ' #error', replace # with the trigraph for #     */
0223  #error "cfortran.h:  Can't find your environment among:\
0224     - GNU gcc (g77) on Linux.                                            \
0225     - MIPS cc and f77 2.0. (e.g. Silicon Graphics, DECstations, ...)     \
0226     - IBM AIX XL C and FORTRAN Compiler/6000 Version 01.01.0000.0000     \
0227     - VAX   VMS CC 3.1 and FORTRAN 5.4.                                  \
0228     - Alpha VMS DEC C 1.3 and DEC FORTRAN 6.0.                           \
0229     - Alpha OSF DEC C and DEC Fortran for OSF/1 AXP Version 1.2          \
0230     - Apollo DomainOS 10.2 (sys5.3) with f77 10.7 and cc 6.7.            \
0231     - CRAY                                                               \
0232     - NEC SX-4 SUPER-UX                                                  \
0233     - CONVEX                                                             \
0234     - Sun                                                                \
0235     - PowerStation Fortran with Visual C++                               \
0236     - HP9000s300/s700/s800 Latest test with: HP-UX A.08.07 A 9000/730    \
0237     - LynxOS: cc or gcc with f2c.                                        \
0238     - VAXUltrix: vcc,cc or gcc with f2c. gcc or cc with f77.             \
0239     -            f77 with vcc works; but missing link magic for f77 I/O. \
0240     -            NO fort. None of gcc, cc or vcc generate required names.\
0241     - f2c/g77:   Use #define    f2cFortran, or cc -Df2cFortran           \
0242     - gfortran:  Use #define    gFortran,   or cc -DgFortran             \
0243                  (also necessary for g77 with -fno-f2c option)           \
0244     - NAG f90: Use #define NAGf90Fortran, or cc -DNAGf90Fortran          \
0245     - Absoft UNIX F77: Use #define AbsoftUNIXFortran or cc -DAbsoftUNIXFortran \
0246     - Absoft Pro Fortran: Use #define AbsoftProFortran \
0247     - Portland Group Fortran: Use #define pgiFortran \
0248     - Intel Fortran: Use #define INTEL_COMPILER"
0249 /* Compiler must throw us out at this point! */
0250 #endif
0251 #endif
0252
0253
0254 #if defined(VAXC) && !defined(__VAXC)
0255 #define OLD_VAXC
0256 #pragma nostandard                       /* Prevent %CC-I-PARAMNOTUSED.       */
0257 #endif
0258
0259 /* Throughout cfortran.h we use: UN = Uppercase Name.  LN = Lowercase Name.   */
0260
0261 /* "extname" changed to "appendus" below (CFITSIO) */
0262 #if defined(f2cFortran) || defined(NAGf90Fortran) || defined(DECFortran) || defined(mipsFortran) || defined(apolloFortran) || defined(sunFortran) || defined(CONVEXFortran) || defined(SXFortran) || defined(appendus)
0263 #define CFC_(UN,LN)            _(LN,_)      /* Lowercase FORTRAN symbols.     */
0264 #define orig_fcallsc(UN,LN)    CFC_(UN,LN)
0265 #else
0266 #if defined(CRAYFortran) || defined(PowerStationFortran) || defined(AbsoftProFortran)
0267 #ifdef _CRAY          /* (UN), not UN, circumvents CRAY preprocessor bug.     */
0268 #define CFC_(UN,LN)            (UN)         /* Uppercase FORTRAN symbols.     */
0269 #else                 /* At least VISUAL_CPLUSPLUS barfs on (UN), so need UN. */
0270 #define CFC_(UN,LN)            UN           /* Uppercase FORTRAN symbols.     */
0271 #endif
0272 #define orig_fcallsc(UN,LN)    CFC_(UN,LN)  /* CRAY insists on arg.'s here.   */
0273 #else  /* For following machines one may wish to change the fcallsc default.  */
0274 #define CF_SAME_NAMESPACE
0275 #ifdef vmsFortran
0276 #define CFC_(UN,LN)            LN           /* Either case FORTRAN symbols.   */
0277      /* BUT we usually use UN for C macro to FORTRAN routines, so use LN here,*/
0278      /* because VAX/VMS doesn't do recursive macros.                          */
0279 #define orig_fcallsc(UN,LN)    UN
0280 #else      /* HP-UX without +ppu or IBMR2 without -qextname. NOT reccomended. */
0281 #define CFC_(UN,LN)            LN           /* Lowercase FORTRAN symbols.     */
0282 #define orig_fcallsc(UN,LN)    CFC_(UN,LN)
0283 #endif /*  vmsFortran */
0284 #endif /* CRAYFortran PowerStationFortran */
0285 #endif /* ....Fortran */
0286
0287 #define fcallsc(UN,LN)               orig_fcallsc(UN,LN)
0288 #define preface_fcallsc(P,p,UN,LN)   CFC_(_(P,UN),_(p,LN))
0289 #define  append_fcallsc(P,p,UN,LN)   CFC_(_(UN,P),_(LN,p))
0290
0291 #define C_FUNCTION(UN,LN)            fcallsc(UN,LN)
0292 #define FORTRAN_FUNCTION(UN,LN)      CFC_(UN,LN)
0293
0294 #ifndef COMMON_BLOCK
0295 #ifndef CONVEXFortran
0296 #ifndef CLIPPERFortran
0297 #if     !(defined(AbsoftUNIXFortran)||defined(AbsoftProFortran))
0298 #define COMMON_BLOCK(UN,LN)          CFC_(UN,LN)
0299 #else
0300 #define COMMON_BLOCK(UN,LN)          _(_C,LN)
0301 #endif  /* AbsoftUNIXFortran or AbsoftProFortran */
0302 #else
0303 #define COMMON_BLOCK(UN,LN)          _(LN,__)
0304 #endif  /* CLIPPERFortran */
0305 #else
0306 #define COMMON_BLOCK(UN,LN)          _3(_,LN,_)
0307 #endif  /* CONVEXFortran */
0308 #endif  /* COMMON_BLOCK */
0309
0310 #ifndef DOUBLE_PRECISION
0311 #if defined(CRAYFortran) && !defined(_CRAYT3E)
0312 #define DOUBLE_PRECISION long double
0313 #else
0314 #define DOUBLE_PRECISION double
0315 #endif
0316 #endif
0317
0318 #ifndef FORTRAN_REAL
0319 #if defined(CRAYFortran) &&  defined(_CRAYT3E)
0320 #define FORTRAN_REAL double
0321 #else
0322 #define FORTRAN_REAL float
0323 #endif
0324 #endif
0325
0326 #ifdef CRAYFortran
0327 #ifdef _CRAY
0328 #include <fortran.h>
0329 #else
0330 #include "fortran.h"  /* i.e. if crosscompiling assume user has file. */
0331 #endif
0332 #define FLOATVVVVVVV_cfPP (FORTRAN_REAL *)   /* Used for C calls FORTRAN.     */
0333 /* CRAY's double==float but CRAY says pointers to doubles and floats are diff.*/
0334 #define VOIDP  (void *)  /* When FORTRAN calls C, we don't know if C routine
0335                             arg.'s have been declared float *, or double *.   */
0336 #else
0337 #define FLOATVVVVVVV_cfPP
0338 #define VOIDP
0339 #endif
0340
0341 #ifdef vmsFortran
0342 #if    defined(vms) || defined(__vms)
0343 #include <descrip.h>
0344 #else
0345 #include "descrip.h"  /* i.e. if crosscompiling assume user has file. */
0346 #endif
0347 #endif
0348
0349 #ifdef sunFortran
0350 #if defined(sun) || defined(__sun)
0351 #include <math.h>     /* Sun's FLOATFUNCTIONTYPE, ASSIGNFLOAT, RETURNFLOAT.  */
0352 #else
0353 #include "math.h"     /* i.e. if crosscompiling assume user has file. */
0354 #endif
0355 /* At least starting with the default C compiler SC3.0.1 of SunOS 5.3,
0356  * FLOATFUNCTIONTYPE, ASSIGNFLOAT, RETURNFLOAT are not required and not in
0357  * <math.h>, since sun C no longer promotes C float return values to doubles.
0358  * Therefore, only use them if defined.
0359  * Even if gcc is being used, assume that it exhibits the Sun C compiler
0360  * behavior in order to be able to use *.o from the Sun C compiler.
0361  * i.e. If FLOATFUNCTIONTYPE, etc. are in math.h, they required by gcc.
0362  */
0363 #endif
0364
0365 #ifndef apolloFortran
0366 #define COMMON_BLOCK_DEF(DEFINITION, NAME) extern DEFINITION NAME
0367 #define CF_NULL_PROTO
0368 #else                                         /* HP doesn't understand #elif. */
0369 /* Without ANSI prototyping, Apollo promotes float functions to double.    */
0370 /* Note that VAX/VMS, IBM, Mips choke on 'type function(...);' prototypes. */
0371 #define CF_NULL_PROTO ...
0372 #ifndef __CF__APOLLO67
0373 #define COMMON_BLOCK_DEF(DEFINITION, NAME) \
0374  DEFINITION NAME __attribute((__section(NAME)))
0375 #else
0376 #define COMMON_BLOCK_DEF(DEFINITION, NAME) \
0377  DEFINITION NAME #attribute[section(NAME)]
0378 #endif
0379 #endif
0380
0381 #ifdef __cplusplus
0382 #undef  CF_NULL_PROTO
0383 #define CF_NULL_PROTO  ...
0384 #endif
0385
0386
0387 #ifndef USE_NEW_DELETE
0388 #ifdef __cplusplus
0389 #define USE_NEW_DELETE 1
0390 #else
0391 #define USE_NEW_DELETE 0
0392 #endif
0393 #endif
0394 #if USE_NEW_DELETE
0395 #define _cf_malloc(N) new char[N]
0396 #define _cf_free(P)   delete[] P
0397 #else
0398 #define _cf_malloc(N) (char *)malloc(N)
0399 #define _cf_free(P)   free(P)
0400 #endif
0401
0402 #ifdef mipsFortran
0403 #define CF_DECLARE_GETARG         int f77argc; char **f77argv
0404 #define CF_SET_GETARG(ARGC,ARGV)  f77argc = ARGC; f77argv = ARGV
0405 #else
0406 #define CF_DECLARE_GETARG
0407 #define CF_SET_GETARG(ARGC,ARGV)
0408 #endif
0409
0410 #ifdef OLD_VAXC                          /* Allow %CC-I-PARAMNOTUSED.         */
0411 #pragma standard
0412 #endif
0413
0414 #define AcfCOMMA ,
0415 #define AcfCOLON ;
0416
0417 /*-------------------------------------------------------------------------*/
0418
0419 /*               UTILITIES USED WITHIN CFORTRAN.H                          */
0420
0421 #define _cfMIN(A,B) (A<B?A:B)
0422
0423 /* 970211 - XIX.145:
0424    firstindexlength  - better name is all_but_last_index_lengths
0425    secondindexlength - better name is         last_index_length
0426  */
0427 #define  firstindexlength(A) (sizeof(A[0])==1 ? 1 : (sizeof(A) / sizeof(A[0])) )
0428 #define secondindexlength(A) (sizeof(A[0])==1 ?      sizeof(A) : sizeof(A[0])  )
0429
0430 /* Behavior of FORTRAN LOGICAL. All machines' LOGICAL is same size as C's int.
0431 Conversion is automatic except for arrays which require F2CLOGICALV/C2FLOGICALV.
0432 f2c, MIPS f77 [DECstation, SGI], VAX Ultrix f77,
0433 HP-UX f77                                        : as in C.
0434 VAX/VMS FORTRAN, VAX Ultrix fort,
0435 Absoft Unix Fortran, IBM RS/6000 xlf             : LS Bit = 0/1 = TRUE/FALSE.
0436 Apollo                                           : neg.   = TRUE, else FALSE.
0437 [Apollo accepts -1 as TRUE for function values, but NOT all other neg. values.]
0438 [DECFortran for Ultrix RISC is also called f77 but is the same as VAX/VMS.]
0439 [MIPS f77 treats .eqv./.neqv. as .eq./.ne. and hence requires LOGICAL_STRICT.]*/
0440
0441 #if defined(NAGf90Fortran) || defined(f2cFortran) || defined(mipsFortran) || defined(PowerStationFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran) || defined(AbsoftProFortran) || defined(SXFortran)
0442 /* SX/PowerStationFortran have 0 and 1 defined, others are neither T nor F.   */
0443 /* hpuxFortran800 has 0 and 0x01000000 defined. Others are unknown.           */
0444 #define LOGICAL_STRICT      /* Other Fortran have .eqv./.neqv. == .eq./.ne.   */
0445 #endif
0446
0447 #define C2FLOGICALV(A,I) \
0448  do {int __i; for(__i=0;__i<I;__i++) A[__i]=C2FLOGICAL(A[__i]); } while (0)
0449 #define F2CLOGICALV(A,I) \
0450  do {int __i; for(__i=0;__i<I;__i++) A[__i]=F2CLOGICAL(A[__i]); } while (0)
0451
0452 #if defined(apolloFortran)
0453 #define C2FLOGICAL(L) ((L)?-1:(L)&~((unsigned)1<<sizeof(int)*8-1))
0454 #define F2CLOGICAL(L) ((L)<0?(L):0)
0455 #else
0456 #if defined(CRAYFortran)
0457 #define C2FLOGICAL(L) _btol(L)
0458 #define F2CLOGICAL(L) _ltob(&(L))     /* Strangely _ltob() expects a pointer. */
0459 #else
0460 #if defined(IBMR2Fortran) || defined(vmsFortran) || defined(DECFortran) || defined(AbsoftUNIXFortran)
0461 /* How come no AbsoftProFortran ? */
0462 #define C2FLOGICAL(L) ((L)?(L)|1:(L)&~(int)1)
0463 #define F2CLOGICAL(L) ((L)&1?(L):0)
0464 #else
0465 #if defined(CONVEXFortran)
0466 #define C2FLOGICAL(L) ((L) ? ~0 : 0 )
0467 #define F2CLOGICAL(L) (L)
0468 #else   /* others evaluate LOGICALs as for C. */
0469 #define C2FLOGICAL(L) (L)
0470 #define F2CLOGICAL(L) (L)
0471 #ifndef LOGICAL_STRICT
0472 #undef  C2FLOGICALV
0473 #undef  F2CLOGICALV
0474 #define C2FLOGICALV(A,I)
0475 #define F2CLOGICALV(A,I)
0476 #endif  /* LOGICAL_STRICT                     */
0477 #endif  /* CONVEXFortran || All Others        */
0478 #endif  /* IBMR2Fortran vmsFortran DECFortran AbsoftUNIXFortran */
0479 #endif  /* CRAYFortran                        */
0480 #endif  /* apolloFortran                      */
0481
0482 /* 970514 - In addition to CRAY, there may be other machines
0483             for which LOGICAL_STRICT makes no sense. */
0484 #if defined(LOGICAL_STRICT) && !defined(CRAYFortran)
0485 /* Force C2FLOGICAL to generate only the values for either .TRUE. or .FALSE.
0486    SX/PowerStationFortran only have 0 and 1 defined.
0487    Elsewhere, only needed if you want to do:
0488      logical lvariable
0489      if (lvariable .eq.  .true.) then       ! (1)
0490    instead of
0491      if (lvariable .eqv. .true.) then       ! (2)
0492    - (1) may not even be FORTRAN/77 and that Apollo's f77 and IBM's xlf
0493      refuse to compile (1), so you are probably well advised to stay away from
0494      (1) and from LOGICAL_STRICT.
0495    - You pay a (slight) performance penalty for using LOGICAL_STRICT. */
0496 #undef  C2FLOGICAL
0497 #ifdef hpuxFortran800
0498 #define C2FLOGICAL(L) ((L)?0x01000000:0)
0499 #else
0500 #if defined(apolloFortran) || defined(vmsFortran) || defined(DECFortran)
0501 #define C2FLOGICAL(L) ((L)?-1:0) /* These machines use -1/0 for .true./.false.*/
0502 #else
0503 #define C2FLOGICAL(L) ((L)? 1:0) /* All others     use +1/0 for .true./.false.*/
0504 #endif
0505 #endif
0506 #endif /* LOGICAL_STRICT */
0507
0508 /* Convert a vector of C strings into FORTRAN strings. */
0509 #ifndef __CF__KnR
0510 static char *c2fstrv(char* cstr, char *fstr, int elem_len, int sizeofcstr)
0511 #else
0512 static char *c2fstrv(      cstr,       fstr,     elem_len,     sizeofcstr)
0513                      char* cstr; char *fstr; int elem_len; int sizeofcstr;
0514 #endif
0515 { int i,j;
0516 /* elem_len includes \0 for C strings. Fortran strings don't have term. \0.
0517    Useful size of string must be the same in both languages. */
0518 for (i=0; i<sizeofcstr/elem_len; i++) {
0519   for (j=1; j<elem_len && *cstr; j++) *fstr++ = *cstr++;
0520   cstr += 1+elem_len-j;
0521   for (; j<elem_len; j++) *fstr++ = ' ';
0522 } /* 95109 - Seems to be returning the original fstr. */
0523 return fstr-sizeofcstr+sizeofcstr/elem_len; }
0524
0525 /* Convert a vector of FORTRAN strings into C strings. */
0526 #ifndef __CF__KnR
0527 static char *f2cstrv(char *fstr, char* cstr, int elem_len, int sizeofcstr)
0528 #else
0529 static char *f2cstrv(      fstr,       cstr,     elem_len,     sizeofcstr)
0530                      char *fstr; char* cstr; int elem_len; int sizeofcstr;
0531 #endif
0532 { int i,j;
0533 /* elem_len includes \0 for C strings. Fortran strings don't have term. \0.
0534    Useful size of string must be the same in both languages. */
0535 cstr += sizeofcstr;
0536 fstr += sizeofcstr - sizeofcstr/elem_len;
0537 for (i=0; i<sizeofcstr/elem_len; i++) {
0538   *--cstr = '\0';
0539   for (j=1; j<elem_len; j++) *--cstr = *--fstr;
0540 } return cstr; }
0541
0542 /* kill the trailing char t's in string s. */
0543 #ifndef __CF__KnR
0544 static char *kill_trailing(char *s, char t)
0545 #else
0546 static char *kill_trailing(      s,      t) char *s; char t;
0547 #endif
0548 {char *e;
0549 e = s + strlen(s);
0550 if (e>s) {                           /* Need this to handle NULL string.*/
0551   while (e>s && *--e==t) {;}         /* Don't follow t's past beginning. */
0552   e[*e==t?0:1] = '\0';               /* Handle s[0]=t correctly.       */
0553 } return s; }
0554
0555 /* kill_trailingn(s,t,e) will kill the trailing t's in string s. e normally
0556 points to the terminating '\0' of s, but may actually point to anywhere in s.
0557 s's new '\0' will be placed at e or earlier in order to remove any trailing t's.
0558 If e<s string s is left unchanged. */
0559 #ifndef __CF__KnR
0560 static char *kill_trailingn(char *s, char t, char *e)
0561 #else
0562 static char *kill_trailingn(      s,      t,       e) char *s; char t; char *e;
0563 #endif
0564 {
0565 if (e==s) *e = '\0';                 /* Kill the string makes sense here.*/
0566 else if (e>s) {                      /* Watch out for neg. length string.*/
0567   while (e>s && *--e==t){;}          /* Don't follow t's past beginning. */
0568   e[*e==t?0:1] = '\0';               /* Handle s[0]=t correctly.       */
0569 } return s; }
0570
0571 /* Note the following assumes that any element which has t's to be chopped off,
0572 does indeed fill the entire element. */
0573 #ifndef __CF__KnR
0574 static char *vkill_trailing(char* cstr, int elem_len, int sizeofcstr, char t)
0575 #else
0576 static char *vkill_trailing(      cstr,     elem_len,     sizeofcstr,      t)
0577                             char* cstr; int elem_len; int sizeofcstr; char t;
0578 #endif
0579 { int i;
0580 for (i=0; i<sizeofcstr/elem_len; i++) /* elem_len includes \0 for C strings. */
0581   kill_trailingn(cstr+elem_len*i,t,cstr+elem_len*(i+1)-1);
0582 return cstr; }
0583
0584 #ifdef vmsFortran
0585 typedef struct dsc$descriptor_s fstring;
0586 #define DSC$DESCRIPTOR_A(DIMCT)                                      \
0587 struct {                                                                       \
0588   unsigned short dsc$w_length;          unsigned char  dsc$b_dtype;          \
0589   unsigned char    dsc$b_class;                    char   *dsc$a_pointer;          \
0590            char    dsc$b_scale;           unsigned char    dsc$b_digits;         \
0591   struct {                                                                     \
0592     unsigned             : 3;     unsigned dsc$v_fl_binscale : 1;      \
0593     unsigned dsc$v_fl_redim    : 1;       unsigned dsc$v_fl_column   : 1;      \
0594     unsigned dsc$v_fl_coeff    : 1;       unsigned dsc$v_fl_bounds   : 1;      \
0595   } dsc$b_aflags;                                                          \
0596   unsigned char    dsc$b_dimct;           unsigned long    dsc$l_arsize;          \
0597            char   *dsc$a_a0;                    long    dsc$l_m [DIMCT];      \
0598   struct {                                                                     \
0599     long dsc$l_l;                         long dsc$l_u;                        \
0600   } dsc$bounds [DIMCT];                                                        \
0601 }
0602 typedef DSC$DESCRIPTOR_A(1) fstringvector;
0603 /*typedef DSC$DESCRIPTOR_A(2) fstringarrarr;
0604   typedef DSC$DESCRIPTOR_A(3) fstringarrarrarr;*/
0605 #define initfstr(F,C,ELEMNO,ELEMLEN)                                           \
0606 ( (F).dsc$l_arsize=  ( (F).dsc$w_length                        =(ELEMLEN) )    \
0607                     *( (F).dsc$l_m[0]=(F).dsc$bounds[0].dsc$l_u=(ELEMNO)  ),   \
0608   (F).dsc$a_a0    =  ( (F).dsc$a_pointer=(C) ) - (F).dsc$w_length          ,(F))
0609
0610 #endif      /* PDW: 2/10/98 (CFITSIO) -- Let VMS see NUM_ELEMS definitions */
0611 #define _NUM_ELEMS      -1
0612 #define _NUM_ELEM_ARG   -2
0613 #define NUM_ELEMS(A)    A,_NUM_ELEMS
0614 #define NUM_ELEM_ARG(B) *_2(A,B),_NUM_ELEM_ARG
0615 #define TERM_CHARS(A,B) A,B
0616 static void __cfortran__notused_dummy();
0617 #ifndef __CF__KnR
0618 static int num_elem(char *strv, unsigned elem_len, int term_char, int num_term)
0619 #else
0620 static int num_elem(      strv,          elem_len,     term_char,     num_term)
0621                     char *strv; unsigned elem_len; int term_char; int num_term;
0622 #endif
0623 /* elem_len is the number of characters in each element of strv, the FORTRAN
0624 vector of strings. The last element of the vector must begin with at least
0625 num_term term_char characters, so that this routine can determine how
0626 many elements are in the vector. */
0627 {
0628 unsigned num,i;
0629 if (num_term == _NUM_ELEMS || num_term == _NUM_ELEM_ARG)
0630   return term_char;
0631 if (num_term <=0) num_term = (int)elem_len;
0632 for (num=0; ; num++) {
0633   for (i=0; i<(unsigned)num_term && *strv==term_char; i++,strv++){;}
0634   if (i==(unsigned)num_term) break;
0635   else strv += elem_len-i;
0636 }
0637 if (num==0) __cfortran__notused_dummy();
0638 return (int)num;
0639 }
0640
0641 static void __cfortran__notused_dummy()
0642 {
0643    /* to prevent not used warnings in gcc (added by ROOT) */
0644    if (0) {
0645       c2fstrv(0, 0, 0, 0); f2cstrv(0, 0, 0, 0); kill_trailing(0, 0);
0646       vkill_trailing(0, 0, 0, 0); num_elem(0, 0, 0, 0);
0647    }
0648 }
0649
0650 /* #endif removed 2/10/98 (CFITSIO) */
0651
0652 /*-------------------------------------------------------------------------*/
0653
0654 /*           UTILITIES FOR C TO USE STRINGS IN FORTRAN COMMON BLOCKS       */
0655
0656 /* C string TO Fortran Common Block STRing. */
0657 /* DIM is the number of DIMensions of the array in terms of strings, not
0658    characters. e.g. char a[12] has DIM = 0, char a[12][4] has DIM = 1, etc. */
0659 #define C2FCBSTR(CSTR,FSTR,DIM)                                                \
0660  c2fstrv((char *)CSTR, (char *)FSTR, sizeof(FSTR)/cfelementsof(FSTR,DIM)+1,    \
0661          sizeof(FSTR)+cfelementsof(FSTR,DIM))
0662
0663 /* Fortran Common Block string TO C STRing. */
0664 #define FCB2CSTR(FSTR,CSTR,DIM)                                                \
0665  vkill_trailing(f2cstrv((char *)FSTR, (char *)CSTR,                            \
0666                         sizeof(FSTR)/cfelementsof(FSTR,DIM)+1,                 \
0667                         sizeof(FSTR)+cfelementsof(FSTR,DIM)),                  \
0668                 sizeof(FSTR)/cfelementsof(FSTR,DIM)+1,                         \
0669                 sizeof(FSTR)+cfelementsof(FSTR,DIM), ' ')
0670
0671 #define cfDEREFERENCE0
0672 #define cfDEREFERENCE1 *
0673 #define cfDEREFERENCE2 **
0674 #define cfDEREFERENCE3 ***
0675 #define cfDEREFERENCE4 ****
0676 #define cfDEREFERENCE5 *****
0677 #define cfelementsof(A,D) (sizeof(A)/sizeof(_(cfDEREFERENCE,D)(A)))
0678
0679 /*-------------------------------------------------------------------------*/
0680
0681 /*               UTILITIES FOR C TO CALL FORTRAN SUBROUTINES               */
0682
0683 /* Define lookup tables for how to handle the various types of variables.  */
0684
0685 #ifdef OLD_VAXC                                /* Prevent %CC-I-PARAMNOTUSED. */
0686 #pragma nostandard
0687 #endif
0688
0689 #define ZTRINGV_NUM(I)       I
0690 #define ZTRINGV_ARGFP(I) (*(_2(A,I))) /* Undocumented. For PINT, etc. */
0691 #define ZTRINGV_ARGF(I) _2(A,I)
0692 #ifdef CFSUBASFUN
0693 #define ZTRINGV_ARGS(I) ZTRINGV_ARGF(I)
0694 #else
0695 #define ZTRINGV_ARGS(I) _2(B,I)
0696 #endif
0697
0698 #define    PBYTE_cfVP(A,B) PINT_cfVP(A,B)
0699 #define  PDOUBLE_cfVP(A,B)
0700 #define   PFLOAT_cfVP(A,B)
0701 #ifdef ZTRINGV_ARGS_allows_Pvariables
0702 /* This allows Pvariables for ARGS. ARGF machinery is above ARGFP.
0703  * B is not needed because the variable may be changed by the Fortran routine,
0704  * but because B is the only way to access an arbitrary macro argument.       */
0705 #define     PINT_cfVP(A,B) int  B = (int)A;              /* For ZSTRINGV_ARGS */
0706 #else
0707 #define     PINT_cfVP(A,B)
0708 #endif
0709 #define PLOGICAL_cfVP(A,B) int *B;      /* Returning LOGICAL in FUNn and SUBn */
0710 #define    PLONG_cfVP(A,B) PINT_cfVP(A,B)
0711 #define   PSHORT_cfVP(A,B) PINT_cfVP(A,B)
0712
0713 #define        VCF_INT_S(T,A,B) _(T,VVVVVVV_cfTYPE) B = A;
0714 #define        VCF_INT_F(T,A,B) _(T,_cfVCF)(A,B)
0715 /* _cfVCF table is directly mapped to _cfCCC table. */
0716 #define     BYTE_cfVCF(A,B)
0717 #define   DOUBLE_cfVCF(A,B)
0718 #if !defined(__CF__KnR)
0719 #define    FLOAT_cfVCF(A,B)
0720 #else
0721 #define    FLOAT_cfVCF(A,B) FORTRAN_REAL B = A;
0722 #endif
0723 #define      INT_cfVCF(A,B)
0724 #define  LOGICAL_cfVCF(A,B)
0725 #define     LONG_cfVCF(A,B)
0726 #define    SHORT_cfVCF(A,B)
0727
0728 /* 980416
0729    Cast (void (*)(CF_NULL_PROTO)) causes SunOS CC 4.2 occasionally to barf,
0730    while the following equivalent typedef is fine.
0731    For consistency use the typedef on all machines.
0732  */
0733 typedef void (*cfCAST_FUNCTION)(CF_NULL_PROTO);
0734
0735 #define VCF(TN,I)       _Icf4(4,V,TN,_(A,I),_(B,I),F)
0736 #define VVCF(TN,AI,BI)  _Icf4(4,V,TN,AI,BI,S)
0737 #define        INT_cfV(T,A,B,F) _(VCF_INT_,F)(T,A,B)
0738 #define       INTV_cfV(T,A,B,F)
0739 #define      INTVV_cfV(T,A,B,F)
0740 #define     INTVVV_cfV(T,A,B,F)
0741 #define    INTVVVV_cfV(T,A,B,F)
0742 #define   INTVVVVV_cfV(T,A,B,F)
0743 #define  INTVVVVVV_cfV(T,A,B,F)
0744 #define INTVVVVVVV_cfV(T,A,B,F)
0745 #define PINT_cfV(      T,A,B,F) _(T,_cfVP)(A,B)
0746 #define PVOID_cfV(     T,A,B,F)
0747 #if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran) || defined(AbsoftProFortran)
0748 #define    ROUTINE_cfV(T,A,B,F) void (*B)(CF_NULL_PROTO) = (cfCAST_FUNCTION)A;
0749 #else
0750 #define    ROUTINE_cfV(T,A,B,F)
0751 #endif
0752 #define     SIMPLE_cfV(T,A,B,F)
0753 #ifdef vmsFortran
0754 #define     STRING_cfV(T,A,B,F) static struct {fstring f; unsigned clen;} B =  \
0755                                        {{0,DSC$K_DTYPE_T,DSC$K_CLASS_S,NULL},0};
0756 #define    PSTRING_cfV(T,A,B,F) static fstring B={0,DSC$K_DTYPE_T,DSC$K_CLASS_S,NULL};
0757 #define    STRINGV_cfV(T,A,B,F) static fstringvector B =                       \
0758   {sizeof(A),DSC$K_DTYPE_T,DSC$K_CLASS_A,NULL,0,0,{0,0,1,1,1},1,0,NULL,0,{1,0}};
0759 #define   PSTRINGV_cfV(T,A,B,F) static fstringvector B =                       \
0760           {0,DSC$K_DTYPE_T,DSC$K_CLASS_A,NULL,0,0,{0,0,1,1,1},1,0,NULL,0,{1,0}};
0761 #else
0762 #define     STRING_cfV(T,A,B,F) struct {unsigned int clen, flen; char *nombre;} B;
0763 #define    STRINGV_cfV(T,A,B,F) struct {char *s, *fs; unsigned flen; char *nombre;} B;
0764 #define    PSTRING_cfV(T,A,B,F) int     B;
0765 #define   PSTRINGV_cfV(T,A,B,F) struct{char *fs; unsigned int sizeofA,flen;}B;
0766 #endif
0767 #define    ZTRINGV_cfV(T,A,B,F)  STRINGV_cfV(T,A,B,F)
0768 #define   PZTRINGV_cfV(T,A,B,F) PSTRINGV_cfV(T,A,B,F)
0769
0770 /* Note that the actions of the A table were performed inside the AA table.
0771    VAX Ultrix vcc, and HP-UX cc, didn't evaluate arguments to functions left to
0772    right, so we had to split the original table into the current robust two. */
0773 #define ACF(NAME,TN,AI,I)      _(TN,_cfSTR)(4,A,NAME,I,AI,_(B,I),0)
0774 #define   DEFAULT_cfA(M,I,A,B)
0775 #define   LOGICAL_cfA(M,I,A,B) B=C2FLOGICAL(B);
0776 #define  PLOGICAL_cfA(M,I,A,B) A=C2FLOGICAL(A);
0777 #define    STRING_cfA(M,I,A,B)  STRING_cfC(M,I,A,B,sizeof(A))
0778 #define   PSTRING_cfA(M,I,A,B) PSTRING_cfC(M,I,A,B,sizeof(A))
0779 #ifdef vmsFortran
0780 #define  AATRINGV_cfA(    A,B, sA,filA,silA)                                   \
0781  initfstr(B,_cf_malloc((sA)-(filA)),(filA),(silA)-1),                          \
0782           c2fstrv(A,B.dsc$a_pointer,(silA),(sA));
0783 #define APATRINGV_cfA(    A,B, sA,filA,silA)                                   \
0784  initfstr(B,A,(filA),(silA)-1),c2fstrv(A,A,(silA),(sA));
0785 #else
0786 #define  AATRINGV_cfA(    A,B, sA,filA,silA)                                   \
0787      (B.s=_cf_malloc((sA)-(filA)),B.fs=c2fstrv(A,B.s,(B.flen=(silA)-1)+1,(sA)));
0788 #define APATRINGV_cfA(    A,B, sA,filA,silA)                                   \
0789  B.fs=c2fstrv(A,A,(B.flen=(silA)-1)+1,B.sizeofA=(sA));
0790 #endif
0791 #define   STRINGV_cfA(M,I,A,B)                                                 \
0792     AATRINGV_cfA((char *)A,B,sizeof(A),firstindexlength(A),secondindexlength(A))
0793 #define  PSTRINGV_cfA(M,I,A,B)                                                 \
0794    APATRINGV_cfA((char *)A,B,sizeof(A),firstindexlength(A),secondindexlength(A))
0795 #define   ZTRINGV_cfA(M,I,A,B)  AATRINGV_cfA( (char *)A,B,                     \
0796                     (_3(M,_ELEMS_,I))*(( _3(M,_ELEMLEN_,I))+1),                \
0797                               (_3(M,_ELEMS_,I)),(_3(M,_ELEMLEN_,I))+1)
0798 #define  PZTRINGV_cfA(M,I,A,B) APATRINGV_cfA( (char *)A,B,                     \
0799                     (_3(M,_ELEMS_,I))*(( _3(M,_ELEMLEN_,I))+1),                \
0800                               (_3(M,_ELEMS_,I)),(_3(M,_ELEMLEN_,I))+1)
0801
0802 #define    PBYTE_cfAAP(A,B) &A
0803 #define  PDOUBLE_cfAAP(A,B) &A
0804 #define   PFLOAT_cfAAP(A,B) FLOATVVVVVVV_cfPP &A
0805 #define     PINT_cfAAP(A,B) &A
0806 #define PLOGICAL_cfAAP(A,B) B= &A         /* B used to keep a common W table. */
0807 #define    PLONG_cfAAP(A,B) &A
0808 #define   PSHORT_cfAAP(A,B) &A
0809
0810 #define AACF(TN,AI,I,C) _SEP_(TN,C,cfCOMMA) _Icf(3,AA,TN,AI,_(B,I))
0811 #define        INT_cfAA(T,A,B) &B
0812 #define       INTV_cfAA(T,A,B) _(T,VVVVVV_cfPP) A
0813 #define      INTVV_cfAA(T,A,B) _(T,VVVVV_cfPP)  A[0]
0814 #define     INTVVV_cfAA(T,A,B) _(T,VVVV_cfPP)   A[0][0]
0815 #define    INTVVVV_cfAA(T,A,B) _(T,VVV_cfPP)    A[0][0][0]
0816 #define   INTVVVVV_cfAA(T,A,B) _(T,VV_cfPP)     A[0][0][0][0]
0817 #define  INTVVVVVV_cfAA(T,A,B) _(T,V_cfPP)      A[0][0][0][0][0]
0818 #define INTVVVVVVV_cfAA(T,A,B) _(T,_cfPP)       A[0][0][0][0][0][0]
0819 #define       PINT_cfAA(T,A,B) _(T,_cfAAP)(A,B)
0820 #define      PVOID_cfAA(T,A,B) (void *) A
0821 #if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran)
0822 #define    ROUTINE_cfAA(T,A,B) &B
0823 #else
0824 #define    ROUTINE_cfAA(T,A,B) (cfCAST_FUNCTION)A
0825 #endif
0826 #define     STRING_cfAA(T,A,B)  STRING_cfCC(T,A,B)
0827 #define    PSTRING_cfAA(T,A,B) PSTRING_cfCC(T,A,B)
0828 #ifdef vmsFortran
0829 #define    STRINGV_cfAA(T,A,B) &B
0830 #else
0831 #ifdef CRAYFortran
0832 #define    STRINGV_cfAA(T,A,B) _cptofcd(B.fs,B.flen)
0833 #else
0834 #define    STRINGV_cfAA(T,A,B) B.fs
0835 #endif
0836 #endif
0837 #define   PSTRINGV_cfAA(T,A,B) STRINGV_cfAA(T,A,B)
0838 #define    ZTRINGV_cfAA(T,A,B) STRINGV_cfAA(T,A,B)
0839 #define   PZTRINGV_cfAA(T,A,B) STRINGV_cfAA(T,A,B)
0840
0841 #if defined(vmsFortran) || defined(CRAYFortran)
0842 #define JCF(TN,I)
0843 #define KCF(TN,I)
0844 #else
0845 #define JCF(TN,I)    _(TN,_cfSTR)(1,J,_(B,I), 0,0,0,0)
0846 #if defined(AbsoftUNIXFortran)
0847 #define  DEFAULT_cfJ(B) ,0
0848 #else
0849 #define  DEFAULT_cfJ(B)
0850 #endif
0851 #define  LOGICAL_cfJ(B) DEFAULT_cfJ(B)
0852 #define PLOGICAL_cfJ(B) DEFAULT_cfJ(B)
0853 #define   STRING_cfJ(B) ,B.flen
0854 #define  PSTRING_cfJ(B) ,B
0855 #define  STRINGV_cfJ(B) STRING_cfJ(B)
0856 #define PSTRINGV_cfJ(B) STRING_cfJ(B)
0857 #define  ZTRINGV_cfJ(B) STRING_cfJ(B)
0858 #define PZTRINGV_cfJ(B) STRING_cfJ(B)
0859
0860 /* KCF is identical to DCF, except that KCF ZTRING is not empty. */
0861 #define KCF(TN,I)    _(TN,_cfSTR)(1,KK,_(B,I), 0,0,0,0)
0862 #if defined(AbsoftUNIXFortran)
0863 #define  DEFAULT_cfKK(B) , unsigned B
0864 #else
0865 #define  DEFAULT_cfKK(B)
0866 #endif
0867 #define  LOGICAL_cfKK(B) DEFAULT_cfKK(B)
0868 #define PLOGICAL_cfKK(B) DEFAULT_cfKK(B)
0869 #define   STRING_cfKK(B) , unsigned B
0870 #define  PSTRING_cfKK(B) STRING_cfKK(B)
0871 #define  STRINGV_cfKK(B) STRING_cfKK(B)
0872 #define PSTRINGV_cfKK(B) STRING_cfKK(B)
0873 #define  ZTRINGV_cfKK(B) STRING_cfKK(B)
0874 #define PZTRINGV_cfKK(B) STRING_cfKK(B)
0875 #endif
0876
0877 #define WCF(TN,AN,I)      _(TN,_cfSTR)(2,W,AN,_(B,I), 0,0,0)
0878 #define  DEFAULT_cfW(A,B)
0879 #define  LOGICAL_cfW(A,B)
0880 #define PLOGICAL_cfW(A,B) *B=F2CLOGICAL(*B);
0881 #define   STRING_cfW(A,B) (B.nombre=A,B.nombre[B.clen]!='\0'?B.nombre[B.clen]='\0':0); /* A?="constnt"*/
0882 #define  PSTRING_cfW(A,B) kill_trailing(A,' ');
0883 #ifdef vmsFortran
0884 #define  STRINGV_cfW(A,B) _cf_free(B.dsc$a_pointer);
0885 #define PSTRINGV_cfW(A,B)                                                      \
0886   vkill_trailing(f2cstrv((char*)A, (char*)A,                                   \
0887                            B.dsc$w_length+1, B.dsc$l_arsize+B.dsc$l_m[0]),     \
0888                    B.dsc$w_length+1, B.dsc$l_arsize+B.dsc$l_m[0], ' ');
0889 #else
0890 #define  STRINGV_cfW(A,B) _cf_free(B.s);
0891 #define PSTRINGV_cfW(A,B) vkill_trailing(                                      \
0892          f2cstrv((char*)A,(char*)A,B.flen+1,B.sizeofA), B.flen+1,B.sizeofA,' ');
0893 #endif
0894 #define  ZTRINGV_cfW(A,B)      STRINGV_cfW(A,B)
0895 #define PZTRINGV_cfW(A,B)     PSTRINGV_cfW(A,B)
0896
0897 #define   NCF(TN,I,C)       _SEP_(TN,C,cfCOMMA) _Icf(2,N,TN,_(A,I),0)
0898 #define  NNCF(TN,I,C)        UUCF(TN,I,C)
0899 #define NNNCF(TN,I,C)       _SEP_(TN,C,cfCOLON) _Icf(2,N,TN,_(A,I),0)
0900 #define        INT_cfN(T,A) _(T,VVVVVVV_cfTYPE) * A
0901 #define       INTV_cfN(T,A) _(T,VVVVVV_cfTYPE)  * A
0902 #define      INTVV_cfN(T,A) _(T,VVVVV_cfTYPE)   * A
0903 #define     INTVVV_cfN(T,A) _(T,VVVV_cfTYPE)    * A
0904 #define    INTVVVV_cfN(T,A) _(T,VVV_cfTYPE)     * A
0905 #define   INTVVVVV_cfN(T,A) _(T,VV_cfTYPE)      * A
0906 #define  INTVVVVVV_cfN(T,A) _(T,V_cfTYPE)       * A
0907 #define INTVVVVVVV_cfN(T,A) _(T,_cfTYPE)        * A
0908 #define       PINT_cfN(T,A) _(T,_cfTYPE)        * A
0909 #define      PVOID_cfN(T,A) void *                A
0910 #if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran)
0911 #define    ROUTINE_cfN(T,A) void (**A)(CF_NULL_PROTO)
0912 #else
0913 #define    ROUTINE_cfN(T,A) void ( *A)(CF_NULL_PROTO)
0914 #endif
0915 #ifdef vmsFortran
0916 #define     STRING_cfN(T,A) fstring *             A
0917 #define    STRINGV_cfN(T,A) fstringvector *       A
0918 #else
0919 #ifdef CRAYFortran
0920 #define     STRING_cfN(T,A) _fcd                  A
0921 #define    STRINGV_cfN(T,A) _fcd                  A
0922 #else
0923 #define     STRING_cfN(T,A) char *                A
0924 #define    STRINGV_cfN(T,A) char *                A
0925 #endif
0926 #endif
0927 #define    PSTRING_cfN(T,A)   STRING_cfN(T,A) /* CRAY insists on arg.'s here. */
0928 #define   PNSTRING_cfN(T,A)   STRING_cfN(T,A) /* CRAY insists on arg.'s here. */
0929 #define   PPSTRING_cfN(T,A)   STRING_cfN(T,A) /* CRAY insists on arg.'s here. */
0930 #define   PSTRINGV_cfN(T,A)  STRINGV_cfN(T,A)
0931 #define    ZTRINGV_cfN(T,A)  STRINGV_cfN(T,A)
0932 #define   PZTRINGV_cfN(T,A) PSTRINGV_cfN(T,A)
0933
0934
0935 /* Apollo 6.7, CRAY, old Sun, VAX/Ultrix vcc/cc and new ultrix
0936    can't hack more than 31 arg's.
0937    e.g. ultrix >= 4.3 gives message:
0938        zow35> cc -c -DDECFortran cfortest.c
0939        cfe: Fatal: Out of memory: cfortest.c
0940        zow35>
0941    Old __hpux had the problem, but new 'HP-UX A.09.03 A 9000/735' is fine
0942    if using -Aa, otherwise we have a problem.
0943  */
0944 #ifndef MAX_PREPRO_ARGS
0945 #if !defined(__GNUC__) && (defined(VAXUltrix) || defined(__CF__APOLLO67) || (defined(sun)&&!defined(__sun)) || defined(_CRAY) || defined(__ultrix__) || (defined(__hpux)&&defined(__CF__KnR)))
0946 #define MAX_PREPRO_ARGS 31
0947 #else
0948 #define MAX_PREPRO_ARGS 99
0949 #endif
0950 #endif
0951
0952 #if defined(AbsoftUNIXFortran) || defined(AbsoftProFortran)
0953 /* In addition to explicit Absoft stuff, only Absoft requires:
0954    - DEFAULT coming from _cfSTR.
0955      DEFAULT could have been called e.g. INT, but keep it for clarity.
0956    - M term in CFARGT14 and CFARGT14FS.
0957  */
0958 #define ABSOFT_cf1(T0) _(T0,_cfSTR)(0,ABSOFT1,0,0,0,0,0)
0959 #define ABSOFT_cf2(T0) _(T0,_cfSTR)(0,ABSOFT2,0,0,0,0,0)
0960 #define ABSOFT_cf3(T0) _(T0,_cfSTR)(0,ABSOFT3,0,0,0,0,0)
0961 #define DEFAULT_cfABSOFT1
0962 #define LOGICAL_cfABSOFT1
0963 #define  STRING_cfABSOFT1 ,MAX_LEN_FORTRAN_FUNCTION_STRING
0964 #define DEFAULT_cfABSOFT2
0965 #define LOGICAL_cfABSOFT2
0966 #define  STRING_cfABSOFT2 ,unsigned D0
0967 #define DEFAULT_cfABSOFT3
0968 #define LOGICAL_cfABSOFT3
0969 #define  STRING_cfABSOFT3 ,D0
0970 #else
0971 #define ABSOFT_cf1(T0)
0972 #define ABSOFT_cf2(T0)
0973 #define ABSOFT_cf3(T0)
0974 #endif
0975
0976 /* _Z introduced to cicumvent IBM and HP silly preprocessor warning.
0977    e.g. "Macro CFARGT14 invoked with a null argument."
0978  */
0979 #define _Z
0980
0981 #define  CFARGT14S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)                \
0982  S(T1,1)   S(T2,2)   S(T3,3)    S(T4,4)    S(T5,5)    S(T6,6)    S(T7,7)       \
0983  S(T8,8)   S(T9,9)   S(TA,10)   S(TB,11)   S(TC,12)   S(TD,13)   S(TE,14)
0984 #define  CFARGT27S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
0985  S(T1,1)   S(T2,2)   S(T3,3)    S(T4,4)    S(T5,5)    S(T6,6)    S(T7,7)       \
0986  S(T8,8)   S(T9,9)   S(TA,10)   S(TB,11)   S(TC,12)   S(TD,13)   S(TE,14)      \
0987  S(TF,15)  S(TG,16)  S(TH,17)   S(TI,18)   S(TJ,19)   S(TK,20)   S(TL,21)      \
0988  S(TM,22)  S(TN,23)  S(TO,24)   S(TP,25)   S(TQ,26)   S(TR,27)
0989
0990 #define  CFARGT14FS(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)           \
0991  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)     \
0992  F(T8,8,1) F(T9,9,1) F(TA,10,1) F(TB,11,1) F(TC,12,1) F(TD,13,1) F(TE,14,1)    \
0993  M       CFARGT14S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
0994 #define  CFARGT27FS(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
0995  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)   \
0996  F(T8,8,1)  F(T9,9,1)  F(TA,10,1) F(TB,11,1) F(TC,12,1) F(TD,13,1) F(TE,14,1)  \
0997  F(TF,15,1) F(TG,16,1) F(TH,17,1) F(TI,18,1) F(TJ,19,1) F(TK,20,1) F(TL,21,1)  \
0998  F(TM,22,1) F(TN,23,1) F(TO,24,1) F(TP,25,1) F(TQ,26,1) F(TR,27,1)             \
0999  M       CFARGT27S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)
1000
1001 #if !(defined(PowerStationFortran)||defined(hpuxFortran800))
1002 /*  Old CFARGT14 -> CFARGT14FS as seen below, for Absoft cross-compile yields:
1003       SunOS> cc -c -Xa -DAbsoftUNIXFortran c.c
1004       "c.c", line 406: warning: argument mismatch
1005     Haven't checked if this is ANSI C or a SunOS bug. SunOS -Xs works ok.
1006     Behavior is most clearly seen in example:
1007       #define A 1 , 2
1008       #define  C(X,Y,Z) x=X. y=Y. z=Z.
1009       #define  D(X,Y,Z) C(X,Y,Z)
1010       D(x,A,z)
1011     Output from preprocessor is: x = x . y = 1 . z = 2 .
1012  #define CFARGT14(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
1013        CFARGT14FS(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
1014 */
1015 #define  CFARGT14(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)             \
1016  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)     \
1017  F(T8,8,1) F(T9,9,1) F(TA,10,1) F(TB,11,1) F(TC,12,1) F(TD,13,1) F(TE,14,1)    \
1018  M       CFARGT14S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
1019 #define  CFARGT27(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
1020  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)   \
1021  F(T8,8,1)  F(T9,9,1)  F(TA,10,1) F(TB,11,1) F(TC,12,1) F(TD,13,1) F(TE,14,1)  \
1022  F(TF,15,1) F(TG,16,1) F(TH,17,1) F(TI,18,1) F(TJ,19,1) F(TK,20,1) F(TL,21,1)  \
1023  F(TM,22,1) F(TN,23,1) F(TO,24,1) F(TP,25,1) F(TQ,26,1) F(TR,27,1)             \
1024  M       CFARGT27S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)
1025
1026 #define  CFARGT20(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \
1027  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)   \
1028  F(T8,8,1)  F(T9,9,1)  F(TA,10,1) F(TB,11,1) F(TC,12,1) F(TD,13,1) F(TE,14,1)  \
1029  F(TF,15,1) F(TG,16,1) F(TH,17,1) F(TI,18,1) F(TJ,19,1) F(TK,20,1)             \
1030  S(T1,1)    S(T2,2)    S(T3,3)    S(T4,4)    S(T5,5)    S(T6,6)    S(T7,7)     \
1031  S(T8,8)    S(T9,9)    S(TA,10)   S(TB,11)   S(TC,12)   S(TD,13)   S(TE,14)    \
1032  S(TF,15)   S(TG,16)   S(TH,17)   S(TI,18)   S(TJ,19)   S(TK,20)
1033 #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) \
1034  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)  \
1035  F(T7,A7,7,1)  F(T8,A8,8,1)  F(T9,A9,9,1) F(TA,AA,10,1) F(TB,AB,11,1) F(TC,AC,12,1) \
1036  F(TD,AD,13,1) F(TE,AE,14,1) S(T1,1)      S(T2,2)       S(T3,3)       S(T4,4)       \
1037  S(T5,5)       S(T6,6)       S(T7,7)      S(T8,8)       S(T9,9)       S(TA,10)      \
1038  S(TB,11)      S(TC,12)      S(TD,13)     S(TE,14)
1039 #if MAX_PREPRO_ARGS>31
1040 #define CFARGTA20(F,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) \
1041  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)  \
1042  F(T7,A7,7,1)  F(T8,A8,8,1)  F(T9,A9,9,1)  F(TA,AA,10,1) F(TB,AB,11,1) F(TC,AC,12,1) \
1043  F(TD,AD,13,1) F(TE,AE,14,1) F(TF,AF,15,1) F(TG,AG,16,1) F(TH,AH,17,1) F(TI,AI,18,1) \
1044  F(TJ,AJ,19,1) F(TK,AK,20,1) S(T1,1)       S(T2,2)       S(T3,3)       S(T4,4)       \
1045  S(T5,5)       S(T6,6)       S(T7,7)       S(T8,8)       S(T9,9)       S(TA,10)      \
1046  S(TB,11)      S(TC,12)      S(TD,13)      S(TE,14)      S(TF,15)      S(TG,16)      \
1047  S(TH,17)      S(TI,18)      S(TJ,19)      S(TK,20)
1048 #define CFARGTA27(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR) \
1049  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)  \
1050  F(T7,A7,7,1)  F(T8,A8,8,1)  F(T9,A9,9,1)  F(TA,AA,10,1) F(TB,AB,11,1) F(TC,AC,12,1) \
1051  F(TD,AD,13,1) F(TE,AE,14,1) F(TF,AF,15,1) F(TG,AG,16,1) F(TH,AH,17,1) F(TI,AI,18,1) \
1052  F(TJ,AJ,19,1) F(TK,AK,20,1) F(TL,AL,21,1) F(TM,AM,22,1) F(TN,AN,23,1) F(TO,AO,24,1) \
1053  F(TP,AP,25,1) F(TQ,AQ,26,1) F(TR,AR,27,1) S(T1,1)       S(T2,2)       S(T3,3)       \
1054  S(T4,4)       S(T5,5)       S(T6,6)       S(T7,7)       S(T8,8)       S(T9,9)       \
1055  S(TA,10)      S(TB,11)      S(TC,12)      S(TD,13)      S(TE,14)      S(TF,15)      \
1056  S(TG,16)      S(TH,17)      S(TI,18)      S(TJ,19)      S(TK,20)      S(TL,21)      \
1057  S(TM,22)      S(TN,23)      S(TO,24)      S(TP,25)      S(TQ,26)      S(TR,27)
1058 #endif
1059 #else
1060 #define  CFARGT14(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)             \
1061  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)  \
1062  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)  \
1063  F(T9,9,1) S(T9,9) F(TA,10,1) S(TA,10) F(TB,11,1) S(TB,11) F(TC,12,1) S(TC,12) \
1064  F(TD,13,1) S(TD,13) F(TE,14,1) S(TE,14)
1065 #define  CFARGT27(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
1066  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)  \
1067  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)  \
1068  F(T9,9,1)  S(T9,9)  F(TA,10,1) S(TA,10) F(TB,11,1) S(TB,11) F(TC,12,1) S(TC,12) \
1069  F(TD,13,1) S(TD,13) F(TE,14,1) S(TE,14) F(TF,15,1) S(TF,15) F(TG,16,1) S(TG,16) \
1070  F(TH,17,1) S(TH,17) F(TI,18,1) S(TI,18) F(TJ,19,1) S(TJ,19) F(TK,20,1) S(TK,20) \
1071  F(TL,21,1) S(TL,21) F(TM,22,1) S(TM,22) F(TN,23,1) S(TN,23) F(TO,24,1) S(TO,24) \
1072  F(TP,25,1) S(TP,25) F(TQ,26,1) S(TQ,26) F(TR,27,1) S(TR,27)
1073
1074 #define  CFARGT20(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \
1075  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)  \
1076  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)  \
1077  F(T9,9,1)  S(T9,9)  F(TA,10,1) S(TA,10) F(TB,11,1) S(TB,11) F(TC,12,1) S(TC,12) \
1078  F(TD,13,1) S(TD,13) F(TE,14,1) S(TE,14) F(TF,15,1) S(TF,15) F(TG,16,1) S(TG,16) \
1079  F(TH,17,1) S(TH,17) F(TI,18,1) S(TI,18) F(TJ,19,1) S(TJ,19) F(TK,20,1) S(TK,20)
1080 #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) \
1081  F(T1,A1,1,0)  S(T1,1)  F(T2,A2,2,1)  S(T2,2)  F(T3,A3,3,1)  S(T3,3)           \
1082  F(T4,A4,4,1)  S(T4,4)  F(T5,A5,5,1)  S(T5,5)  F(T6,A6,6,1)  S(T6,6)           \
1083  F(T7,A7,7,1)  S(T7,7)  F(T8,A8,8,1)  S(T8,8)  F(T9,A9,9,1)  S(T9,9)           \
1084  F(TA,AA,10,1) S(TA,10) F(TB,AB,11,1) S(TB,11) F(TC,AC,12,1) S(TC,12)          \
1085  F(TD,AD,13,1) S(TD,13) F(TE,AE,14,1) S(TE,14)
1086 #if MAX_PREPRO_ARGS>31
1087 #define CFARGTA20(F,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) \
1088  F(T1,A1,1,0)  S(T1,1)  F(T2,A2,2,1)  S(T2,2)  F(T3,A3,3,1)  S(T3,3)           \
1089  F(T4,A4,4,1)  S(T4,4)  F(T5,A5,5,1)  S(T5,5)  F(T6,A6,6,1)  S(T6,6)           \
1090  F(T7,A7,7,1)  S(T7,7)  F(T8,A8,8,1)  S(T8,8)  F(T9,A9,9,1)  S(T9,9)           \
1091  F(TA,AA,10,1) S(TA,10) F(TB,AB,11,1) S(TB,11) F(TC,AC,12,1) S(TC,12)          \
1092  F(TD,AD,13,1) S(TD,13) F(TE,AE,14,1) S(TE,14) F(TF,AF,15,1) S(TF,15)          \
1093  F(TG,AG,16,1) S(TG,16) F(TH,AH,17,1) S(TH,17) F(TI,AI,18,1) S(TI,18)          \
1094  F(TJ,AJ,19,1) S(TJ,19) F(TK,AK,20,1) S(TK,20)
1095 #define CFARGTA27(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR) \
1096  F(T1,A1,1,0)  S(T1,1)  F(T2,A2,2,1)  S(T2,2)  F(T3,A3,3,1)  S(T3,3)           \
1097  F(T4,A4,4,1)  S(T4,4)  F(T5,A5,5,1)  S(T5,5)  F(T6,A6,6,1)  S(T6,6)           \
1098  F(T7,A7,7,1)  S(T7,7)  F(T8,A8,8,1)  S(T8,8)  F(T9,A9,9,1)  S(T9,9)           \
1099  F(TA,AA,10,1) S(TA,10) F(TB,AB,11,1) S(TB,11) F(TC,AC,12,1) S(TC,12)          \
1100  F(TD,AD,13,1) S(TD,13) F(TE,AE,14,1) S(TE,14) F(TF,AF,15,1) S(TF,15)          \
1101  F(TG,AG,16,1) S(TG,16) F(TH,AH,17,1) S(TH,17) F(TI,AI,18,1) S(TI,18)          \
1102  F(TJ,AJ,19,1) S(TJ,19) F(TK,AK,20,1) S(TK,20) F(TL,AL,21,1) S(TL,21)          \
1103  F(TM,AM,22,1) S(TM,22) F(TN,AN,23,1) S(TN,23) F(TO,AO,24,1) S(TO,24)          \
1104  F(TP,AP,25,1) S(TP,25) F(TQ,AQ,26,1) S(TQ,26) F(TR,AR,27,1) S(TR,27)
1105 #endif
1106 #endif
1107
1108
1109 #define PROTOCCALLSFSUB1( UN,LN,T1) \
1110         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)
1111 #define PROTOCCALLSFSUB2( UN,LN,T1,T2) \
1112         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)
1113 #define PROTOCCALLSFSUB3( UN,LN,T1,T2,T3) \
1114         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)
1115 #define PROTOCCALLSFSUB4( UN,LN,T1,T2,T3,T4) \
1116         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)
1117 #define PROTOCCALLSFSUB5( UN,LN,T1,T2,T3,T4,T5) \
1118         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)
1119 #define PROTOCCALLSFSUB6( UN,LN,T1,T2,T3,T4,T5,T6) \
1120         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)
1121 #define PROTOCCALLSFSUB7( UN,LN,T1,T2,T3,T4,T5,T6,T7) \
1122         PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
1123 #define PROTOCCALLSFSUB8( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \
1124         PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
1125 #define PROTOCCALLSFSUB9( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \
1126         PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0,CF_0,CF_0,CF_0,CF_0)
1127 #define PROTOCCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \
1128         PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0)
1129 #define PROTOCCALLSFSUB11(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \
1130         PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0)
1131 #define PROTOCCALLSFSUB12(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \
1132         PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0)
1133 #define PROTOCCALLSFSUB13(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \
1134         PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0)
1135
1136
1137 #define PROTOCCALLSFSUB15(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF) \
1138         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)
1139 #define PROTOCCALLSFSUB16(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG) \
1140         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)
1141 #define PROTOCCALLSFSUB17(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH) \
1142         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)
1143 #define PROTOCCALLSFSUB18(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI) \
1144         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)
1145 #define PROTOCCALLSFSUB19(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ) \
1146         PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,CF_0)
1147
1148 #define PROTOCCALLSFSUB21(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL) \
1149         PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
1150 #define PROTOCCALLSFSUB22(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM) \
1151         PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,CF_0,CF_0,CF_0,CF_0,CF_0)
1152 #define PROTOCCALLSFSUB23(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN) \
1153         PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,CF_0,CF_0,CF_0,CF_0)
1154 #define PROTOCCALLSFSUB24(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO) \
1155         PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,CF_0,CF_0,CF_0)
1156 #define PROTOCCALLSFSUB25(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP) \
1157         PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,CF_0,CF_0)
1158 #define PROTOCCALLSFSUB26(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ) \
1159         PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,CF_0)
1160
1161
1162 #ifndef FCALLSC_QUALIFIER
1163 #ifdef VISUAL_CPLUSPLUS
1164 #define FCALLSC_QUALIFIER __stdcall
1165 #else
1166 #define FCALLSC_QUALIFIER
1167 #endif
1168 #endif
1169
1170 #ifdef __cplusplus
1171 #define CFextern extern "C"
1172 #else
1173 #define CFextern extern
1174 #endif
1175
1176
1177 #ifdef CFSUBASFUN
1178 #define PROTOCCALLSFSUB0(UN,LN) \
1179    PROTOCCALLSFFUN0( VOID,UN,LN)
1180 #define PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
1181    PROTOCCALLSFFUN14(VOID,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
1182 #define PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)\
1183    PROTOCCALLSFFUN20(VOID,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)
1184 #define PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)\
1185    PROTOCCALLSFFUN27(VOID,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)
1186 #else
1187 /* Note: Prevent compiler warnings, null #define PROTOCCALLSFSUB14/20 after
1188    #include-ing cfortran.h if calling the FORTRAN wrapper within the same
1189    source code where the wrapper is created. */
1190 #define PROTOCCALLSFSUB0(UN,LN)     _(VOID,_cfPU)(CFC_(UN,LN))();
1191 #ifndef __CF__KnR
1192 #define PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
1193  _(VOID,_cfPU)(CFC_(UN,LN))( CFARGT14(NCF,KCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) );
1194 #define PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)\
1195  _(VOID,_cfPU)(CFC_(UN,LN))( CFARGT20(NCF,KCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) );
1196 #define PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)\
1197  _(VOID,_cfPU)(CFC_(UN,LN))( CFARGT27(NCF,KCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) );
1198 #else
1199 #define PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)     \
1200          PROTOCCALLSFSUB0(UN,LN)
1201 #define PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \
1202          PROTOCCALLSFSUB0(UN,LN)
1203 #define PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
1204          PROTOCCALLSFSUB0(UN,LN)
1205 #endif
1206 #endif
1207
1208
1209 #ifdef OLD_VAXC                                  /* Allow %CC-I-PARAMNOTUSED. */
1210 #pragma standard
1211 #endif
1212
1213
1214 #define CCALLSFSUB1( UN,LN,T1,                        A1)         \
1215         CCALLSFSUB5 (UN,LN,T1,CF_0,CF_0,CF_0,CF_0,A1,0,0,0,0)
1216 #define CCALLSFSUB2( UN,LN,T1,T2,                     A1,A2)      \
1217         CCALLSFSUB5 (UN,LN,T1,T2,CF_0,CF_0,CF_0,A1,A2,0,0,0)
1218 #define CCALLSFSUB3( UN,LN,T1,T2,T3,                  A1,A2,A3)   \
1219         CCALLSFSUB5 (UN,LN,T1,T2,T3,CF_0,CF_0,A1,A2,A3,0,0)
1220 #define CCALLSFSUB4( UN,LN,T1,T2,T3,T4,               A1,A2,A3,A4)\
1221         CCALLSFSUB5 (UN,LN,T1,T2,T3,T4,CF_0,A1,A2,A3,A4,0)
1222 #define CCALLSFSUB5( UN,LN,T1,T2,T3,T4,T5,            A1,A2,A3,A4,A5)          \
1223         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)
1224 #define CCALLSFSUB6( UN,LN,T1,T2,T3,T4,T5,T6,         A1,A2,A3,A4,A5,A6)       \
1225         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)
1226 #define CCALLSFSUB7( UN,LN,T1,T2,T3,T4,T5,T6,T7,      A1,A2,A3,A4,A5,A6,A7)    \
1227         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)
1228 #define CCALLSFSUB8( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,   A1,A2,A3,A4,A5,A6,A7,A8) \
1229         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)
1230 #define CCALLSFSUB9( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,A1,A2,A3,A4,A5,A6,A7,A8,A9)\
1231         CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,0)
1232 #define CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA)\
1233         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)
1234 #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)\
1235         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)
1236 #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)\
1237         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)
1238 #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)\
1239         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)
1240
1241 #ifdef __cplusplus
1242 #define CPPPROTOCLSFSUB0( UN,LN)
1243 #define CPPPROTOCLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
1244 #define CPPPROTOCLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)
1245 #define CPPPROTOCLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)
1246 #else
1247 #define CPPPROTOCLSFSUB0(UN,LN) \
1248         PROTOCCALLSFSUB0(UN,LN)
1249 #define CPPPROTOCLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)     \
1250         PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
1251 #define CPPPROTOCLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \
1252         PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)
1253 #define CPPPROTOCLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
1254         PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)
1255 #endif
1256
1257 #ifdef CFSUBASFUN
1258 #define CCALLSFSUB0(UN,LN) CCALLSFFUN0(UN,LN)
1259 #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)\
1260         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)
1261 #else
1262 /* do{...}while(0) allows if(a==b) FORT(); else BORT(); */
1263 #define CCALLSFSUB0( UN,LN) do{CPPPROTOCLSFSUB0(UN,LN) CFC_(UN,LN)();}while(0)
1264 #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)\
1265 do{VVCF(T1,A1,B1) VVCF(T2,A2,B2) VVCF(T3,A3,B3) VVCF(T4,A4,B4) VVCF(T5,A5,B5)  \
1266    VVCF(T6,A6,B6) VVCF(T7,A7,B7) VVCF(T8,A8,B8) VVCF(T9,A9,B9) VVCF(TA,AA,B10) \
1267    VVCF(TB,AB,B11) VVCF(TC,AC,B12) VVCF(TD,AD,B13) VVCF(TE,AE,B14)             \
1268    CPPPROTOCLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)          \
1269    ACF(LN,T1,A1,1)  ACF(LN,T2,A2,2)  ACF(LN,T3,A3,3)                           \
1270    ACF(LN,T4,A4,4)  ACF(LN,T5,A5,5)  ACF(LN,T6,A6,6)  ACF(LN,T7,A7,7)          \
1271    ACF(LN,T8,A8,8)  ACF(LN,T9,A9,9)  ACF(LN,TA,AA,10) ACF(LN,TB,AB,11)         \
1272    ACF(LN,TC,AC,12) ACF(LN,TD,AD,13) ACF(LN,TE,AE,14)                          \
1273    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) );\
1274    WCF(T1,A1,1)  WCF(T2,A2,2)  WCF(T3,A3,3)  WCF(T4,A4,4)  WCF(T5,A5,5)        \
1275    WCF(T6,A6,6)  WCF(T7,A7,7)  WCF(T8,A8,8)  WCF(T9,A9,9)  WCF(TA,AA,10)       \
1276    WCF(TB,AB,11) WCF(TC,AC,12) WCF(TD,AD,13) WCF(TE,AE,14)      }while(0)
1277 #endif
1278
1279
1280 #if MAX_PREPRO_ARGS>31
1281 #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)\
1282         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)
1283 #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)\
1284         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)
1285 #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)\
1286         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)
1287 #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)\
1288         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)
1289 #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)\
1290         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)
1291
1292 #ifdef CFSUBASFUN
1293 #define CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH, \
1294         TI,TJ,TK, A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) \
1295         CCALLSFFUN20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH, \
1296         TI,TJ,TK, A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK)
1297 #else
1298 #define CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH, \
1299         TI,TJ,TK, A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) \
1300 do{VVCF(T1,A1,B1)  VVCF(T2,A2,B2)  VVCF(T3,A3,B3)  VVCF(T4,A4,B4)  VVCF(T5,A5,B5)   \
1301    VVCF(T6,A6,B6)  VVCF(T7,A7,B7)  VVCF(T8,A8,B8)  VVCF(T9,A9,B9)  VVCF(TA,AA,B10)  \
1302    VVCF(TB,AB,B11) VVCF(TC,AC,B12) VVCF(TD,AD,B13) VVCF(TE,AE,B14) VVCF(TF,AF,B15)  \
1303    VVCF(TG,AG,B16) VVCF(TH,AH,B17) VVCF(TI,AI,B18) VVCF(TJ,AJ,B19) VVCF(TK,AK,B20)  \
1304    CPPPROTOCLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)  \
1305    ACF(LN,T1,A1,1)  ACF(LN,T2,A2,2)  ACF(LN,T3,A3,3)  ACF(LN,T4,A4,4)          \
1306    ACF(LN,T5,A5,5)  ACF(LN,T6,A6,6)  ACF(LN,T7,A7,7)  ACF(LN,T8,A8,8)          \
1307    ACF(LN,T9,A9,9)  ACF(LN,TA,AA,10) ACF(LN,TB,AB,11) ACF(LN,TC,AC,12)         \
1308    ACF(LN,TD,AD,13) ACF(LN,TE,AE,14) ACF(LN,TF,AF,15) ACF(LN,TG,AG,16)         \
1309    ACF(LN,TH,AH,17) ACF(LN,TI,AI,18) ACF(LN,TJ,AJ,19) ACF(LN,TK,AK,20)         \
1310    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) ); \
1311  WCF(T1,A1,1)  WCF(T2,A2,2)  WCF(T3,A3,3)  WCF(T4,A4,4)  WCF(T5,A5,5)  WCF(T6,A6,6)  \
1312  WCF(T7,A7,7)  WCF(T8,A8,8)  WCF(T9,A9,9)  WCF(TA,AA,10) WCF(TB,AB,11) WCF(TC,AC,12) \
1313  WCF(TD,AD,13) WCF(TE,AE,14) WCF(TF,AF,15) WCF(TG,AG,16) WCF(TH,AH,17) WCF(TI,AI,18) \
1314  WCF(TJ,AJ,19) WCF(TK,AK,20) }while(0)
1315 #endif
1316 #endif         /* MAX_PREPRO_ARGS */
1317
1318 #if MAX_PREPRO_ARGS>31
1319 #define CCALLSFSUB21(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL)\
1320         CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,CF_0,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,AG,AH,AI,AJ,AK,AL,0,0,0,0,0,0)
1321 #define CCALLSFSUB22(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM)\
1322         CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,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,AG,AH,AI,AJ,AK,AL,AM,0,0,0,0,0)
1323 #define CCALLSFSUB23(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN)\
1324         CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,0,0,0,0)
1325 #define CCALLSFSUB24(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO)\
1326         CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,0,0,0)
1327 #define CCALLSFSUB25(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP)\
1328         CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,0,0)
1329 #define CCALLSFSUB26(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ)\
1330         CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,0)
1331
1332 #ifdef CFSUBASFUN
1333 #define CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR, \
1334                            A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR) \
1335         CCALLSFFUN27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR, \
1336                            A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR)
1337 #else
1338 #define CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR, \
1339                            A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR) \
1340 do{VVCF(T1,A1,B1)  VVCF(T2,A2,B2)  VVCF(T3,A3,B3)  VVCF(T4,A4,B4)  VVCF(T5,A5,B5)   \
1341    VVCF(T6,A6,B6)  VVCF(T7,A7,B7)  VVCF(T8,A8,B8)  VVCF(T9,A9,B9)  VVCF(TA,AA,B10)  \
1342    VVCF(TB,AB,B11) VVCF(TC,AC,B12) VVCF(TD,AD,B13) VVCF(TE,AE,B14) VVCF(TF,AF,B15)  \
1343    VVCF(TG,AG,B16) VVCF(TH,AH,B17) VVCF(TI,AI,B18) VVCF(TJ,AJ,B19) VVCF(TK,AK,B20)  \
1344    VVCF(TL,AL,B21) VVCF(TM,AM,B22) VVCF(TN,AN,B23) VVCF(TO,AO,B24) VVCF(TP,AP,B25)  \
1345    VVCF(TQ,AQ,B26) VVCF(TR,AR,B27)                                                  \
1346    CPPPROTOCLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
1347    ACF(LN,T1,A1,1)  ACF(LN,T2,A2,2)  ACF(LN,T3,A3,3)  ACF(LN,T4,A4,4)          \
1348    ACF(LN,T5,A5,5)  ACF(LN,T6,A6,6)  ACF(LN,T7,A7,7)  ACF(LN,T8,A8,8)          \
1349    ACF(LN,T9,A9,9)  ACF(LN,TA,AA,10) ACF(LN,TB,AB,11) ACF(LN,TC,AC,12)         \
1350    ACF(LN,TD,AD,13) ACF(LN,TE,AE,14) ACF(LN,TF,AF,15) ACF(LN,TG,AG,16)         \
1351    ACF(LN,TH,AH,17) ACF(LN,TI,AI,18) ACF(LN,TJ,AJ,19) ACF(LN,TK,AK,20)         \
1352    ACF(LN,TL,AL,21) ACF(LN,TM,AM,22) ACF(LN,TN,AN,23) ACF(LN,TO,AO,24)         \
1353    ACF(LN,TP,AP,25) ACF(LN,TQ,AQ,26) ACF(LN,TR,AR,27)                          \
1354    CFC_(UN,LN)( CFARGTA27(AACF,JCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR,\
1355                                    A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR) ); \
1356  WCF(T1,A1,1)  WCF(T2,A2,2)  WCF(T3,A3,3)  WCF(T4,A4,4)  WCF(T5,A5,5)  WCF(T6,A6,6)  \
1357  WCF(T7,A7,7)  WCF(T8,A8,8)  WCF(T9,A9,9)  WCF(TA,AA,10) WCF(TB,AB,11) WCF(TC,AC,12) \
1358  WCF(TD,AD,13) WCF(TE,AE,14) WCF(TF,AF,15) WCF(TG,AG,16) WCF(TH,AH,17) WCF(TI,AI,18) \
1359  WCF(TJ,AJ,19) WCF(TK,AK,20) WCF(TL,AL,21) WCF(TM,AM,22) WCF(TN,AN,23) WCF(TO,AO,24) \
1360  WCF(TP,AP,25) WCF(TQ,AQ,26) WCF(TR,AR,27) }while(0)
1361 #endif
1362 #endif         /* MAX_PREPRO_ARGS */
1363
1364 /*-------------------------------------------------------------------------*/
1365
1366 /*               UTILITIES FOR C TO CALL FORTRAN FUNCTIONS                 */
1367
1368 /*N.B. PROTOCCALLSFFUNn(..) generates code, whether or not the FORTRAN
1369   function is called. Therefore, especially for creator's of C header files
1370   for large FORTRAN libraries which include many functions, to reduce
1371   compile time and object code size, it may be desirable to create
1372   preprocessor directives to allow users to create code for only those
1373   functions which they use.                                                */
1374
1375 /* The following defines the maximum length string that a function can return.
1376    Of course it may be undefine-d and re-define-d before individual
1377    PROTOCCALLSFFUNn(..) as required. It would also be nice to have this derived
1378    from the individual machines' limits.                                      */
1379 #define MAX_LEN_FORTRAN_FUNCTION_STRING 0x4FE
1380
1381 /* The following defines a character used by CFORTRAN.H to flag the end of a
1382    string coming out of a FORTRAN routine.                                 */
1383 #define CFORTRAN_NON_CHAR 0x7F
1384
1385 #ifdef OLD_VAXC                                /* Prevent %CC-I-PARAMNOTUSED. */
1386 #pragma nostandard
1387 #endif
1388
1389 #define _SEP_(TN,C,cfCOMMA)     _(__SEP_,C)(TN,cfCOMMA)
1390 #define __SEP_0(TN,cfCOMMA)
1391 #define __SEP_1(TN,cfCOMMA)     _Icf(2,SEP,TN,cfCOMMA,0)
1392 #define        INT_cfSEP(T,B) _(A,B)
1393 #define       INTV_cfSEP(T,B) INT_cfSEP(T,B)
1394 #define      INTVV_cfSEP(T,B) INT_cfSEP(T,B)
1395 #define     INTVVV_cfSEP(T,B) INT_cfSEP(T,B)
1396 #define    INTVVVV_cfSEP(T,B) INT_cfSEP(T,B)
1397 #define   INTVVVVV_cfSEP(T,B) INT_cfSEP(T,B)
1398 #define  INTVVVVVV_cfSEP(T,B) INT_cfSEP(T,B)
1399 #define INTVVVVVVV_cfSEP(T,B) INT_cfSEP(T,B)
1400 #define       PINT_cfSEP(T,B) INT_cfSEP(T,B)
1401 #define      PVOID_cfSEP(T,B) INT_cfSEP(T,B)
1402 #define    ROUTINE_cfSEP(T,B) INT_cfSEP(T,B)
1403 #define     SIMPLE_cfSEP(T,B) INT_cfSEP(T,B)
1404 #define       VOID_cfSEP(T,B) INT_cfSEP(T,B)    /* For FORTRAN calls C subr.s.*/
1405 #define     STRING_cfSEP(T,B) INT_cfSEP(T,B)
1406 #define    STRINGV_cfSEP(T,B) INT_cfSEP(T,B)
1407 #define    PSTRING_cfSEP(T,B) INT_cfSEP(T,B)
1408 #define   PSTRINGV_cfSEP(T,B) INT_cfSEP(T,B)
1409 #define   PNSTRING_cfSEP(T,B) INT_cfSEP(T,B)
1410 #define   PPSTRING_cfSEP(T,B) INT_cfSEP(T,B)
1411 #define    ZTRINGV_cfSEP(T,B) INT_cfSEP(T,B)
1412 #define   PZTRINGV_cfSEP(T,B) INT_cfSEP(T,B)
1413
1414 #if defined(SIGNED_BYTE) || !defined(UNSIGNED_BYTE)
1415 #ifdef OLD_VAXC
1416 #define INTEGER_BYTE               char    /* Old VAXC barfs on 'signed char' */
1417 #else
1418 #define INTEGER_BYTE        signed char    /* default */
1419 #endif
1420 #else
1421 #define INTEGER_BYTE        unsigned char
1422 #endif
1423 #define    BYTEVVVVVVV_cfTYPE INTEGER_BYTE
1424 #define  DOUBLEVVVVVVV_cfTYPE DOUBLE_PRECISION
1425 #define   FLOATVVVVVVV_cfTYPE FORTRAN_REAL
1426 #define     INTVVVVVVV_cfTYPE int
1427 #define LOGICALVVVVVVV_cfTYPE int
1428 #define    LONGVVVVVVV_cfTYPE long
1429 #define LONGLONGVVVVVVV_cfTYPE LONGLONG   /* added by MR December 2005 */
1430 #define   SHORTVVVVVVV_cfTYPE short
1431 #define          PBYTE_cfTYPE INTEGER_BYTE
1432 #define        PDOUBLE_cfTYPE DOUBLE_PRECISION
1433 #define         PFLOAT_cfTYPE FORTRAN_REAL
1434 #define           PINT_cfTYPE int
1435 #define       PLOGICAL_cfTYPE int
1436 #define          PLONG_cfTYPE long
1437 #define      PLONGLONG_cfTYPE LONGLONG  /* added by MR December 2005 */
1438 #define         PSHORT_cfTYPE short
1439
1440 #define CFARGS0(A,T,V,W,X,Y,Z) _3(T,_cf,A)
1441 #define CFARGS1(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V)
1442 #define CFARGS2(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W)
1443 #define CFARGS3(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W,X)
1444 #define CFARGS4(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W,X,Y)
1445 #define CFARGS5(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W,X,Y,Z)
1446
1447 #define  _Icf(N,T,I,X,Y)                 _(I,_cfINT)(N,T,I,X,Y,0)
1448 #define _Icf4(N,T,I,X,Y,Z)               _(I,_cfINT)(N,T,I,X,Y,Z)
1449 #define           BYTE_cfINT(N,A,B,X,Y,Z)        DOUBLE_cfINT(N,A,B,X,Y,Z)
1450 #define         DOUBLE_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INT,B,X,Y,Z,0)
1451 #define          FLOAT_cfINT(N,A,B,X,Y,Z)        DOUBLE_cfINT(N,A,B,X,Y,Z)
1452 #define            INT_cfINT(N,A,B,X,Y,Z)        DOUBLE_cfINT(N,A,B,X,Y,Z)
1453 #define        LOGICAL_cfINT(N,A,B,X,Y,Z)        DOUBLE_cfINT(N,A,B,X,Y,Z)
1454 #define           LONG_cfINT(N,A,B,X,Y,Z)        DOUBLE_cfINT(N,A,B,X,Y,Z)
1455 #define       LONGLONG_cfINT(N,A,B,X,Y,Z)        DOUBLE_cfINT(N,A,B,X,Y,Z) /* added by MR December 2005 */
1456 #define          SHORT_cfINT(N,A,B,X,Y,Z)        DOUBLE_cfINT(N,A,B,X,Y,Z)
1457 #define          PBYTE_cfINT(N,A,B,X,Y,Z)       PDOUBLE_cfINT(N,A,B,X,Y,Z)
1458 #define        PDOUBLE_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,PINT,B,X,Y,Z,0)
1459 #define         PFLOAT_cfINT(N,A,B,X,Y,Z)       PDOUBLE_cfINT(N,A,B,X,Y,Z)
1460 #define           PINT_cfINT(N,A,B,X,Y,Z)       PDOUBLE_cfINT(N,A,B,X,Y,Z)
1461 #define       PLOGICAL_cfINT(N,A,B,X,Y,Z)       PDOUBLE_cfINT(N,A,B,X,Y,Z)
1462 #define          PLONG_cfINT(N,A,B,X,Y,Z)       PDOUBLE_cfINT(N,A,B,X,Y,Z)
1463 #define      PLONGLONG_cfINT(N,A,B,X,Y,Z)       PDOUBLE_cfINT(N,A,B,X,Y,Z) /* added by MR December 2005 */
1464 #define         PSHORT_cfINT(N,A,B,X,Y,Z)       PDOUBLE_cfINT(N,A,B,X,Y,Z)
1465 #define          BYTEV_cfINT(N,A,B,X,Y,Z)       DOUBLEV_cfINT(N,A,B,X,Y,Z)
1466 #define         BYTEVV_cfINT(N,A,B,X,Y,Z)      DOUBLEVV_cfINT(N,A,B,X,Y,Z)
1467 #define        BYTEVVV_cfINT(N,A,B,X,Y,Z)     DOUBLEVVV_cfINT(N,A,B,X,Y,Z)
1468 #define       BYTEVVVV_cfINT(N,A,B,X,Y,Z)    DOUBLEVVVV_cfINT(N,A,B,X,Y,Z)
1469 #define      BYTEVVVVV_cfINT(N,A,B,X,Y,Z)   DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z)
1470 #define     BYTEVVVVVV_cfINT(N,A,B,X,Y,Z)  DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z)
1471 #define    BYTEVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z)
1472 #define        DOUBLEV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTV,B,X,Y,Z,0)
1473 #define       DOUBLEVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVV,B,X,Y,Z,0)
1474 #define      DOUBLEVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVV,B,X,Y,Z,0)
1475 #define     DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVV,B,X,Y,Z,0)
1476 #define    DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVVV,B,X,Y,Z,0)
1477 #define   DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVVVV,B,X,Y,Z,0)
1478 #define  DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVVVVV,B,X,Y,Z,0)
1479 #define         FLOATV_cfINT(N,A,B,X,Y,Z)       DOUBLEV_cfINT(N,A,B,X,Y,Z)
1480 #define        FLOATVV_cfINT(N,A,B,X,Y,Z)      DOUBLEVV_cfINT(N,A,B,X,Y,Z)
1481 #define       FLOATVVV_cfINT(N,A,B,X,Y,Z)     DOUBLEVVV_cfINT(N,A,B,X,Y,Z)
1482 #define      FLOATVVVV_cfINT(N,A,B,X,Y,Z)    DOUBLEVVVV_cfINT(N,A,B,X,Y,Z)
1483 #define     FLOATVVVVV_cfINT(N,A,B,X,Y,Z)   DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z)
1484 #define    FLOATVVVVVV_cfINT(N,A,B,X,Y,Z)  DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z)
1485 #define   FLOATVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z)
1486 #define           INTV_cfINT(N,A,B,X,Y,Z)       DOUBLEV_cfINT(N,A,B,X,Y,Z)
1487 #define          INTVV_cfINT(N,A,B,X,Y,Z)      DOUBLEVV_cfINT(N,A,B,X,Y,Z)
1488 #define         INTVVV_cfINT(N,A,B,X,Y,Z)     DOUBLEVVV_cfINT(N,A,B,X,Y,Z)
1489 #define        INTVVVV_cfINT(N,A,B,X,Y,Z)    DOUBLEVVVV_cfINT(N,A,B,X,Y,Z)
1490 #define       INTVVVVV_cfINT(N,A,B,X,Y,Z)   DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z)
1491 #define      INTVVVVVV_cfINT(N,A,B,X,Y,Z)  DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z)
1492 #define     INTVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z)
1493 #define       LOGICALV_cfINT(N,A,B,X,Y,Z)       DOUBLEV_cfINT(N,A,B,X,Y,Z)
1494 #define      LOGICALVV_cfINT(N,A,B,X,Y,Z)      DOUBLEVV_cfINT(N,A,B,X,Y,Z)
1495 #define     LOGICALVVV_cfINT(N,A,B,X,Y,Z)     DOUBLEVVV_cfINT(N,A,B,X,Y,Z)
1496 #define    LOGICALVVVV_cfINT(N,A,B,X,Y,Z)    DOUBLEVVVV_cfINT(N,A,B,X,Y,Z)
1497 #define   LOGICALVVVVV_cfINT(N,A,B,X,Y,Z)   DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z)
1498 #define  LOGICALVVVVVV_cfINT(N,A,B,X,Y,Z)  DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z)
1499 #define LOGICALVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z)
1500 #define          LONGV_cfINT(N,A,B,X,Y,Z)       DOUBLEV_cfINT(N,A,B,X,Y,Z)
1501 #define         LONGVV_cfINT(N,A,B,X,Y,Z)      DOUBLEVV_cfINT(N,A,B,X,Y,Z)
1502 #define        LONGVVV_cfINT(N,A,B,X,Y,Z)     DOUBLEVVV_cfINT(N,A,B,X,Y,Z)
1503 #define       LONGVVVV_cfINT(N,A,B,X,Y,Z)    DOUBLEVVVV_cfINT(N,A,B,X,Y,Z)
1504 #define      LONGVVVVV_cfINT(N,A,B,X,Y,Z)   DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z)
1505 #define     LONGVVVVVV_cfINT(N,A,B,X,Y,Z)  DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z)
1506 #define    LONGVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z)
1507 #define      LONGLONGV_cfINT(N,A,B,X,Y,Z)       DOUBLEV_cfINT(N,A,B,X,Y,Z) /* added by MR December 2005 */
1508 #define     LONGLONGVV_cfINT(N,A,B,X,Y,Z)      DOUBLEVV_cfINT(N,A,B,X,Y,Z) /* added by MR December 2005 */
1509 #define    LONGLONGVVV_cfINT(N,A,B,X,Y,Z)     DOUBLEVVV_cfINT(N,A,B,X,Y,Z) /* added by MR December 2005 */
1510 #define   LONGLONGVVVV_cfINT(N,A,B,X,Y,Z)    DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) /* added by MR December 2005 */
1511 #define  LONGLONGVVVVV_cfINT(N,A,B,X,Y,Z)   DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) /* added by MR December 2005 */
1512 #define LONGLONGVVVVVV_cfINT(N,A,B,X,Y,Z)  DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) /* added by MR December 2005 */
1513 #define LONGLONGVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) /* added by MR December 2005 */
1514 #define         SHORTV_cfINT(N,A,B,X,Y,Z)       DOUBLEV_cfINT(N,A,B,X,Y,Z)
1515 #define        SHORTVV_cfINT(N,A,B,X,Y,Z)      DOUBLEVV_cfINT(N,A,B,X,Y,Z)
1516 #define       SHORTVVV_cfINT(N,A,B,X,Y,Z)     DOUBLEVVV_cfINT(N,A,B,X,Y,Z)
1517 #define      SHORTVVVV_cfINT(N,A,B,X,Y,Z)    DOUBLEVVVV_cfINT(N,A,B,X,Y,Z)
1518 #define     SHORTVVVVV_cfINT(N,A,B,X,Y,Z)   DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z)
1519 #define    SHORTVVVVVV_cfINT(N,A,B,X,Y,Z)  DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z)
1520 #define   SHORTVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z)
1521 #define          PVOID_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,B,B,X,Y,Z,0)
1522 #define        ROUTINE_cfINT(N,A,B,X,Y,Z)         PVOID_cfINT(N,A,B,X,Y,Z)
1523 /*CRAY coughs on the first,
1524   i.e. the usual trouble of not being able to
1525   define macros to macros with arguments.
1526   New ultrix is worse, it coughs on all such uses.
1527  */
1528 /*#define       SIMPLE_cfINT                    PVOID_cfINT*/
1529 #define         SIMPLE_cfINT(N,A,B,X,Y,Z)         PVOID_cfINT(N,A,B,X,Y,Z)
1530 #define           VOID_cfINT(N,A,B,X,Y,Z)         PVOID_cfINT(N,A,B,X,Y,Z)
1531 #define         STRING_cfINT(N,A,B,X,Y,Z)         PVOID_cfINT(N,A,B,X,Y,Z)
1532 #define        STRINGV_cfINT(N,A,B,X,Y,Z)         PVOID_cfINT(N,A,B,X,Y,Z)
1533 #define        PSTRING_cfINT(N,A,B,X,Y,Z)         PVOID_cfINT(N,A,B,X,Y,Z)
1534 #define       PSTRINGV_cfINT(N,A,B,X,Y,Z)         PVOID_cfINT(N,A,B,X,Y,Z)
1535 #define       PNSTRING_cfINT(N,A,B,X,Y,Z)         PVOID_cfINT(N,A,B,X,Y,Z)
1536 #define       PPSTRING_cfINT(N,A,B,X,Y,Z)         PVOID_cfINT(N,A,B,X,Y,Z)
1537 #define        ZTRINGV_cfINT(N,A,B,X,Y,Z)         PVOID_cfINT(N,A,B,X,Y,Z)
1538 #define       PZTRINGV_cfINT(N,A,B,X,Y,Z)         PVOID_cfINT(N,A,B,X,Y,Z)
1539 #define           CF_0_cfINT(N,A,B,X,Y,Z)
1540
1541
1542 #define   UCF(TN,I,C)  _SEP_(TN,C,cfCOMMA) _Icf(2,U,TN,_(A,I),0)
1543 #define  UUCF(TN,I,C)  _SEP_(TN,C,cfCOMMA) _SEP_(TN,1,I)
1544 #define UUUCF(TN,I,C)  _SEP_(TN,C,cfCOLON) _Icf(2,U,TN,_(A,I),0)
1545 #define        INT_cfU(T,A) _(T,VVVVVVV_cfTYPE)   A
1546 #define       INTV_cfU(T,A) _(T,VVVVVV_cfTYPE)  * A
1547 #define      INTVV_cfU(T,A) _(T,VVVVV_cfTYPE)   * A
1548 #define     INTVVV_cfU(T,A) _(T,VVVV_cfTYPE)    * A
1549 #define    INTVVVV_cfU(T,A) _(T,VVV_cfTYPE)     * A
1550 #define   INTVVVVV_cfU(T,A) _(T,VV_cfTYPE)      * A
1551 #define  INTVVVVVV_cfU(T,A) _(T,V_cfTYPE)       * A
1552 #define INTVVVVVVV_cfU(T,A) _(T,_cfTYPE)        * A
1553 #define       PINT_cfU(T,A) _(T,_cfTYPE)        * A
1554 #define      PVOID_cfU(T,A) void  *A
1555 #define    ROUTINE_cfU(T,A) void (*A)(CF_NULL_PROTO)
1556 #define       VOID_cfU(T,A) void   A    /* Needed for C calls FORTRAN sub.s.  */
1557 #define     STRING_cfU(T,A) char  *A    /*            via VOID and wrapper.   */
1558 #define    STRINGV_cfU(T,A) char  *A
1559 #define    PSTRING_cfU(T,A) char  *A
1560 #define   PSTRINGV_cfU(T,A) char  *A
1561 #define    ZTRINGV_cfU(T,A) char  *A
1562 #define   PZTRINGV_cfU(T,A) char  *A
1563
1564 /* VOID breaks U into U and UU. */
1565 #define       INT_cfUU(T,A) _(T,VVVVVVV_cfTYPE) A
1566 #define      VOID_cfUU(T,A)             /* Needed for FORTRAN calls C sub.s.  */
1567 #define    STRING_cfUU(T,A) char *A
1568
1569
1570 #define      BYTE_cfPU(A)   CFextern INTEGER_BYTE      FCALLSC_QUALIFIER A
1571 #define    DOUBLE_cfPU(A)   CFextern DOUBLE_PRECISION  FCALLSC_QUALIFIER A
1572 #if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT))
1573 #if defined (f2cFortran) && ! defined (gFortran)
1574 /* f2c/g77 return double from FORTRAN REAL functions. (KMCCARTY, 2005/12/09) */
1575 #define     FLOAT_cfPU(A)   CFextern DOUBLE_PRECISION  FCALLSC_QUALIFIER A
1576 #else
1577 #define     FLOAT_cfPU(A)   CFextern FORTRAN_REAL      FCALLSC_QUALIFIER A
1578 #endif
1579 #else
1580 #define     FLOAT_cfPU(A)   CFextern FLOATFUNCTIONTYPE FCALLSC_QUALIFIER A
1581 #endif
1582 #define       INT_cfPU(A)   CFextern int   FCALLSC_QUALIFIER   A
1583 #define   LOGICAL_cfPU(A)   CFextern int   FCALLSC_QUALIFIER   A
1584 #define      LONG_cfPU(A)   CFextern long  FCALLSC_QUALIFIER   A
1585 #define     SHORT_cfPU(A)   CFextern short FCALLSC_QUALIFIER   A
1586 #define    STRING_cfPU(A)   CFextern void  FCALLSC_QUALIFIER   A
1587 #define      VOID_cfPU(A)   CFextern void  FCALLSC_QUALIFIER   A
1588
1589 #define    BYTE_cfE INTEGER_BYTE     A0;
1590 #define  DOUBLE_cfE DOUBLE_PRECISION A0;
1591 #if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT))
1592 #define   FLOAT_cfE FORTRAN_REAL  A0;
1593 #else
1594 #define   FLOAT_cfE FORTRAN_REAL AA0;   FLOATFUNCTIONTYPE A0;
1595 #endif
1596 #define     INT_cfE int    A0;
1597 #define LOGICAL_cfE int    A0;
1598 #define    LONG_cfE long   A0;
1599 #define   SHORT_cfE short  A0;
1600 #define    VOID_cfE
1601 #ifdef vmsFortran
1602 #define  STRING_cfE static char AA0[1+MAX_LEN_FORTRAN_FUNCTION_STRING];        \
1603                        static fstring A0 =                                     \
1604              {MAX_LEN_FORTRAN_FUNCTION_STRING,DSC$K_DTYPE_T,DSC$K_CLASS_S,AA0};\
1605                memset(AA0, CFORTRAN_NON_CHAR, MAX_LEN_FORTRAN_FUNCTION_STRING);\
1606                                     *(AA0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0';
1607 #else
1608 #ifdef CRAYFortran
1609 #define  STRING_cfE static char AA0[1+MAX_LEN_FORTRAN_FUNCTION_STRING];        \
1610                    static _fcd A0; *(AA0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0';\
1611                 memset(AA0,CFORTRAN_NON_CHAR, MAX_LEN_FORTRAN_FUNCTION_STRING);\
1612                             A0 = _cptofcd(AA0,MAX_LEN_FORTRAN_FUNCTION_STRING);
1613 #else
1614 /* 'cc: SC3.0.1 13 Jul 1994' barfs on char A0[0x4FE+1];
1615  * char A0[0x4FE +1]; char A0[1+0x4FE]; are both OK.     */
1616 #define STRING_cfE static char A0[1+MAX_LEN_FORTRAN_FUNCTION_STRING];          \
1617                        memset(A0, CFORTRAN_NON_CHAR,                           \
1618                               MAX_LEN_FORTRAN_FUNCTION_STRING);                \
1619                        *(A0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0';
1620 #endif
1621 #endif
1622 /* ESTRING must use static char. array which is guaranteed to exist after
1623    function returns.                                                     */
1624
1625 /* N.B.i) The diff. for 0 (Zero) and >=1 arguments.
1626        ii)That the following create an unmatched bracket, i.e. '(', which
1627           must of course be matched in the call.
1628        iii)Commas must be handled very carefully                         */
1629 #define    INT_cfGZ(T,UN,LN) A0=CFC_(UN,LN)(
1630 #define   VOID_cfGZ(T,UN,LN)    CFC_(UN,LN)(
1631 #ifdef vmsFortran
1632 #define STRING_cfGZ(T,UN,LN)    CFC_(UN,LN)(&A0
1633 #else
1634 #if defined(CRAYFortran) || defined(AbsoftUNIXFortran) || defined(AbsoftProFortran)
1635 #define STRING_cfGZ(T,UN,LN)    CFC_(UN,LN)( A0
1636 #else
1637 #define STRING_cfGZ(T,UN,LN)    CFC_(UN,LN)( A0,MAX_LEN_FORTRAN_FUNCTION_STRING
1638 #endif
1639 #endif
1640
1641 #define     INT_cfG(T,UN,LN)    INT_cfGZ(T,UN,LN)
1642 #define    VOID_cfG(T,UN,LN)   VOID_cfGZ(T,UN,LN)
1643 #define  STRING_cfG(T,UN,LN) STRING_cfGZ(T,UN,LN), /*, is only diff. from _cfG*/
1644
1645 #define    BYTEVVVVVVV_cfPP
1646 #define     INTVVVVVVV_cfPP     /* These complement FLOATVVVVVVV_cfPP. */
1647 #define  DOUBLEVVVVVVV_cfPP
1648 #define LOGICALVVVVVVV_cfPP
1649 #define    LONGVVVVVVV_cfPP
1650 #define   SHORTVVVVVVV_cfPP
1651 #define          PBYTE_cfPP
1652 #define           PINT_cfPP
1653 #define        PDOUBLE_cfPP
1654 #define       PLOGICAL_cfPP
1655 #define          PLONG_cfPP
1656 #define         PSHORT_cfPP
1657 #define         PFLOAT_cfPP FLOATVVVVVVV_cfPP
1658
1659 #define BCF(TN,AN,C)        _SEP_(TN,C,cfCOMMA) _Icf(2,B,TN,AN,0)
1660 #define        INT_cfB(T,A) (_(T,VVVVVVV_cfTYPE)) A
1661 #define       INTV_cfB(T,A)            A
1662 #define      INTVV_cfB(T,A)           (A)[0]
1663 #define     INTVVV_cfB(T,A)           (A)[0][0]
1664 #define    INTVVVV_cfB(T,A)           (A)[0][0][0]
1665 #define   INTVVVVV_cfB(T,A)           (A)[0][0][0][0]
1666 #define  INTVVVVVV_cfB(T,A)           (A)[0][0][0][0][0]
1667 #define INTVVVVVVV_cfB(T,A)           (A)[0][0][0][0][0][0]
1668 #define       PINT_cfB(T,A) _(T,_cfPP)&A
1669 #define     STRING_cfB(T,A) (char *)   A
1670 #define    STRINGV_cfB(T,A) (char *)   A
1671 #define    PSTRING_cfB(T,A) (char *)   A
1672 #define   PSTRINGV_cfB(T,A) (char *)   A
1673 #define      PVOID_cfB(T,A) (void *)   A
1674 #define    ROUTINE_cfB(T,A) (cfCAST_FUNCTION)A
1675 #define    ZTRINGV_cfB(T,A) (char *)   A
1676 #define   PZTRINGV_cfB(T,A) (char *)   A
1677
1678 #define SCF(TN,NAME,I,A)    _(TN,_cfSTR)(3,S,NAME,I,A,0,0)
1679 #define  DEFAULT_cfS(M,I,A)
1680 #define  LOGICAL_cfS(M,I,A)
1681 #define PLOGICAL_cfS(M,I,A)
1682 #define   STRING_cfS(M,I,A) ,sizeof(A)
1683 #define  STRINGV_cfS(M,I,A) ,( (unsigned)0xFFFF*firstindexlength(A) \
1684                               +secondindexlength(A))
1685 #define  PSTRING_cfS(M,I,A) ,sizeof(A)
1686 #define PSTRINGV_cfS(M,I,A) STRINGV_cfS(M,I,A)
1687 #define  ZTRINGV_cfS(M,I,A)
1688 #define PZTRINGV_cfS(M,I,A)
1689
1690 #define   HCF(TN,I)         _(TN,_cfSTR)(3,H,cfCOMMA, H,_(C,I),0,0)
1691 #define  HHCF(TN,I)         _(TN,_cfSTR)(3,H,cfCOMMA,HH,_(C,I),0,0)
1692 #define HHHCF(TN,I)         _(TN,_cfSTR)(3,H,cfCOLON, H,_(C,I),0,0)
1693 #define  H_CF_SPECIAL       unsigned
1694 #define HH_CF_SPECIAL
1695 #define  DEFAULT_cfH(M,I,A)
1696 #define  LOGICAL_cfH(S,U,B)
1697 #define PLOGICAL_cfH(S,U,B)
1698 #define   STRING_cfH(S,U,B) _(A,S) _(U,_CF_SPECIAL) B
1699 #define  STRINGV_cfH(S,U,B) STRING_cfH(S,U,B)
1700 #define  PSTRING_cfH(S,U,B) STRING_cfH(S,U,B)
1701 #define PSTRINGV_cfH(S,U,B) STRING_cfH(S,U,B)
1702 #define PNSTRING_cfH(S,U,B) STRING_cfH(S,U,B)
1703 #define PPSTRING_cfH(S,U,B) STRING_cfH(S,U,B)
1704 #define  ZTRINGV_cfH(S,U,B)
1705 #define PZTRINGV_cfH(S,U,B)
1706
1707 /* Need VOID_cfSTR because Absoft forced function types go through _cfSTR. */
1708 /* No spaces inside expansion. They screws up macro catenation kludge.     */
1709 #define           VOID_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1710 #define           BYTE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1711 #define         DOUBLE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1712 #define          FLOAT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1713 #define            INT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1714 #define        LOGICAL_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,LOGICAL,A,B,C,D,E)
1715 #define           LONG_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1716 #define       LONGLONG_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) /* added by MR December 2005 */
1717 #define          SHORT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1718 #define          BYTEV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1719 #define         BYTEVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1720 #define        BYTEVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1721 #define       BYTEVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1722 #define      BYTEVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1723 #define     BYTEVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1724 #define    BYTEVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1725 #define        DOUBLEV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1726 #define       DOUBLEVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1727 #define      DOUBLEVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1728 #define     DOUBLEVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1729 #define    DOUBLEVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1730 #define   DOUBLEVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1731 #define  DOUBLEVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1732 #define         FLOATV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1733 #define        FLOATVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1734 #define       FLOATVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1735 #define      FLOATVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1736 #define     FLOATVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1737 #define    FLOATVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1738 #define   FLOATVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1739 #define           INTV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1740 #define          INTVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1741 #define         INTVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1742 #define        INTVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1743 #define       INTVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1744 #define      INTVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1745 #define     INTVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1746 #define       LOGICALV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1747 #define      LOGICALVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1748 #define     LOGICALVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1749 #define    LOGICALVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1750 #define   LOGICALVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1751 #define  LOGICALVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1752 #define LOGICALVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1753 #define          LONGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1754 #define         LONGVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1755 #define        LONGVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1756 #define       LONGVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1757 #define      LONGVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1758 #define     LONGVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1759 #define    LONGVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1760 #define      LONGLONGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) /* added by MR December 2005 */
1761 #define     LONGLONGVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) /* added by MR December 2005 */
1762 #define    LONGLONGVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) /* added by MR December 2005 */
1763 #define   LONGLONGVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) /* added by MR December 2005 */
1764 #define  LONGLONGVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) /* added by MR December 2005 */
1765 #define LONGLONGVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) /* added by MR December 2005 */
1766 #define LONGLONGVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) /* added by MR December 2005 */
1767 #define         SHORTV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1768 #define        SHORTVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1769 #define       SHORTVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1770 #define      SHORTVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1771 #define     SHORTVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1772 #define    SHORTVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1773 #define   SHORTVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1774 #define          PBYTE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1775 #define        PDOUBLE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1776 #define         PFLOAT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1777 #define           PINT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1778 #define       PLOGICAL_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PLOGICAL,A,B,C,D,E)
1779 #define          PLONG_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1780 #define      PLONGLONG_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) /* added by MR December 2005 */
1781 #define         PSHORT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1782 #define         STRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,STRING,A,B,C,D,E)
1783 #define        PSTRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PSTRING,A,B,C,D,E)
1784 #define        STRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,STRINGV,A,B,C,D,E)
1785 #define       PSTRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PSTRINGV,A,B,C,D,E)
1786 #define       PNSTRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PNSTRING,A,B,C,D,E)
1787 #define       PPSTRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PPSTRING,A,B,C,D,E)
1788 #define          PVOID_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1789 #define        ROUTINE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1790 #define         SIMPLE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1791 #define        ZTRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,ZTRINGV,A,B,C,D,E)
1792 #define       PZTRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PZTRINGV,A,B,C,D,E)
1793 #define           CF_0_cfSTR(N,T,A,B,C,D,E)
1794
1795 /* See ACF table comments, which explain why CCF was split into two. */
1796 #define CCF(NAME,TN,I)     _(TN,_cfSTR)(5,C,NAME,I,_(A,I),_(B,I),_(C,I))
1797 #define  DEFAULT_cfC(M,I,A,B,C)
1798 #define  LOGICAL_cfC(M,I,A,B,C)  A=C2FLOGICAL( A);
1799 #define PLOGICAL_cfC(M,I,A,B,C) *A=C2FLOGICAL(*A);
1800 #ifdef vmsFortran
1801 #define   STRING_cfC(M,I,A,B,C) (B.clen=strlen(A),B.f.dsc$a_pointer=A,         \
1802         C==sizeof(char*)||C==(unsigned)(B.clen+1)?B.f.dsc$w_length=B.clen:     \
1803           (memset((A)+B.clen,' ',C-B.clen-1),A[B.f.dsc$w_length=C-1]='\0'));
1804       /* PSTRING_cfC to beware of array A which does not contain any \0.      */
1805 #define  PSTRING_cfC(M,I,A,B,C) (B.dsc$a_pointer=A, C==sizeof(char*) ?         \
1806              B.dsc$w_length=strlen(A):  (A[C-1]='\0',B.dsc$w_length=strlen(A), \
1807        memset((A)+B.dsc$w_length,' ',C-B.dsc$w_length-1), B.dsc$w_length=C-1));
1808 #else
1809 #define   STRING_cfC(M,I,A,B,C) (B.nombre=A,B.clen=strlen(A),                             \
1810                 C==sizeof(char*)||C==(unsigned)(B.clen+1)?B.flen=B.clen:       \
1811                         (memset(B.nombre+B.clen,' ',C-B.clen-1),B.nombre[B.flen=C-1]='\0'));
1812 #define  PSTRING_cfC(M,I,A,B,C) (C==sizeof(char*)? B=strlen(A):                \
1813                     (A[C-1]='\0',B=strlen(A),memset((A)+B,' ',C-B-1),B=C-1));
1814 #endif
1815           /* For CRAYFortran for (P)STRINGV_cfC, B.fs is set, but irrelevant. */
1816 #define  STRINGV_cfC(M,I,A,B,C) \
1817         AATRINGV_cfA(    A,B,(C/0xFFFF)*(C%0xFFFF),C/0xFFFF,C%0xFFFF)
1818 #define PSTRINGV_cfC(M,I,A,B,C) \
1819        APATRINGV_cfA(    A,B,(C/0xFFFF)*(C%0xFFFF),C/0xFFFF,C%0xFFFF)
1820 #define  ZTRINGV_cfC(M,I,A,B,C) \
1821         AATRINGV_cfA(    A,B, (_3(M,_ELEMS_,I))*((_3(M,_ELEMLEN_,I))+1),       \
1822                               (_3(M,_ELEMS_,I)), (_3(M,_ELEMLEN_,I))+1   )
1823 #define PZTRINGV_cfC(M,I,A,B,C) \
1824        APATRINGV_cfA(    A,B, (_3(M,_ELEMS_,I))*((_3(M,_ELEMLEN_,I))+1),       \
1825                               (_3(M,_ELEMS_,I)), (_3(M,_ELEMLEN_,I))+1   )
1826
1827 #define     BYTE_cfCCC(A,B) &A
1828 #define   DOUBLE_cfCCC(A,B) &A
1829 #if !defined(__CF__KnR)
1830 #define    FLOAT_cfCCC(A,B) &A
1831                                /* Although the VAX doesn't, at least the      */
1832 #else                          /* HP and K&R mips promote float arg.'s of     */
1833 #define    FLOAT_cfCCC(A,B) &B /* unprototyped functions to double. Cannot    */
1834 #endif                         /* use A here to pass the argument to FORTRAN. */
1835 #define      INT_cfCCC(A,B) &A
1836 #define  LOGICAL_cfCCC(A,B) &A
1837 #define     LONG_cfCCC(A,B) &A
1838 #define    SHORT_cfCCC(A,B) &A
1839 #define    PBYTE_cfCCC(A,B)  A
1840 #define  PDOUBLE_cfCCC(A,B)  A
1841 #define   PFLOAT_cfCCC(A,B)  A
1842 #define     PINT_cfCCC(A,B)  A
1843 #define PLOGICAL_cfCCC(A,B)  B=A       /* B used to keep a common W table. */
1844 #define    PLONG_cfCCC(A,B)  A
1845 #define   PSHORT_cfCCC(A,B)  A
1846
1847 #define CCCF(TN,I,M)           _SEP_(TN,M,cfCOMMA) _Icf(3,CC,TN,_(A,I),_(B,I))
1848 #define        INT_cfCC(T,A,B) _(T,_cfCCC)(A,B)
1849 #define       INTV_cfCC(T,A,B)  A
1850 #define      INTVV_cfCC(T,A,B)  A
1851 #define     INTVVV_cfCC(T,A,B)  A
1852 #define    INTVVVV_cfCC(T,A,B)  A
1853 #define   INTVVVVV_cfCC(T,A,B)  A
1854 #define  INTVVVVVV_cfCC(T,A,B)  A
1855 #define INTVVVVVVV_cfCC(T,A,B)  A
1856 #define       PINT_cfCC(T,A,B) _(T,_cfCCC)(A,B)
1857 #define      PVOID_cfCC(T,A,B)  A
1858 #if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran)
1859 #define    ROUTINE_cfCC(T,A,B) &A
1860 #else
1861 #define    ROUTINE_cfCC(T,A,B)  A
1862 #endif
1863 #define     SIMPLE_cfCC(T,A,B)  A
1864 #ifdef vmsFortran
1865 #define     STRING_cfCC(T,A,B) &B.f
1866 #define    STRINGV_cfCC(T,A,B) &B
1867 #define    PSTRING_cfCC(T,A,B) &B
1868 #define   PSTRINGV_cfCC(T,A,B) &B
1869 #else
1870 #ifdef CRAYFortran
1871 #define     STRING_cfCC(T,A,B) _cptofcd(A,B.flen)
1872 #define    STRINGV_cfCC(T,A,B) _cptofcd(B.s,B.flen)
1873 #define    PSTRING_cfCC(T,A,B) _cptofcd(A,B)
1874 #define   PSTRINGV_cfCC(T,A,B) _cptofcd(A,B.flen)
1875 #else
1876 #define     STRING_cfCC(T,A,B)  A
1877 #define    STRINGV_cfCC(T,A,B)  B.fs
1878 #define    PSTRING_cfCC(T,A,B)  A
1879 #define   PSTRINGV_cfCC(T,A,B)  B.fs
1880 #endif
1881 #endif
1882 #define    ZTRINGV_cfCC(T,A,B)   STRINGV_cfCC(T,A,B)
1883 #define   PZTRINGV_cfCC(T,A,B)  PSTRINGV_cfCC(T,A,B)
1884
1885 #define    BYTE_cfX  return A0;
1886 #define  DOUBLE_cfX  return A0;
1887 #if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT))
1888 #define   FLOAT_cfX  return A0;
1889 #else
1890 #define   FLOAT_cfX  ASSIGNFLOAT(AA0,A0); return AA0;
1891 #endif
1892 #define     INT_cfX  return A0;
1893 #define LOGICAL_cfX  return F2CLOGICAL(A0);
1894 #define    LONG_cfX  return A0;
1895 #define   SHORT_cfX  return A0;
1896 #define    VOID_cfX  return   ;
1897 #if defined(vmsFortran) || defined(CRAYFortran)
1898 #define  STRING_cfX  return kill_trailing(                                     \
1899                                       kill_trailing(AA0,CFORTRAN_NON_CHAR),' ');
1900 #else
1901 #define  STRING_cfX  return kill_trailing(                                     \
1902                                       kill_trailing( A0,CFORTRAN_NON_CHAR),' ');
1903 #endif
1904
1905 #define CFFUN(NAME) _(__cf__,NAME)
1906
1907 /* Note that we don't use LN here, but we keep it for consistency. */
1908 #define CCALLSFFUN0(UN,LN) CFFUN(UN)()
1909
1910 #ifdef OLD_VAXC                                  /* Allow %CC-I-PARAMNOTUSED. */
1911 #pragma standard
1912 #endif
1913
1914 #define CCALLSFFUN1( UN,LN,T1,                        A1)         \
1915         CCALLSFFUN5 (UN,LN,T1,CF_0,CF_0,CF_0,CF_0,A1,0,0,0,0)
1916 #define CCALLSFFUN2( UN,LN,T1,T2,                     A1,A2)      \
1917         CCALLSFFUN5 (UN,LN,T1,T2,CF_0,CF_0,CF_0,A1,A2,0,0,0)
1918 #define CCALLSFFUN3( UN,LN,T1,T2,T3,                  A1,A2,A3)   \
1919         CCALLSFFUN5 (UN,LN,T1,T2,T3,CF_0,CF_0,A1,A2,A3,0,0)
1920 #define CCALLSFFUN4( UN,LN,T1,T2,T3,T4,               A1,A2,A3,A4)\
1921         CCALLSFFUN5 (UN,LN,T1,T2,T3,T4,CF_0,A1,A2,A3,A4,0)
1922 #define CCALLSFFUN5( UN,LN,T1,T2,T3,T4,T5,            A1,A2,A3,A4,A5)          \
1923         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)
1924 #define CCALLSFFUN6( UN,LN,T1,T2,T3,T4,T5,T6,         A1,A2,A3,A4,A5,A6)       \
1925         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)
1926 #define CCALLSFFUN7( UN,LN,T1,T2,T3,T4,T5,T6,T7,      A1,A2,A3,A4,A5,A6,A7)    \
1927         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)
1928 #define CCALLSFFUN8( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,   A1,A2,A3,A4,A5,A6,A7,A8) \
1929         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)
1930 #define CCALLSFFUN9( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,A1,A2,A3,A4,A5,A6,A7,A8,A9)\
1931         CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,0)
1932 #define CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA)\
1933         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)
1934 #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)\
1935         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)
1936 #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)\
1937         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)
1938 #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)\
1939         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)
1940
1941 #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)\
1942 ((CFFUN(UN)(  BCF(T1,A1,0) BCF(T2,A2,1) BCF(T3,A3,1) BCF(T4,A4,1) BCF(T5,A5,1) \
1943               BCF(T6,A6,1) BCF(T7,A7,1) BCF(T8,A8,1) BCF(T9,A9,1) BCF(TA,AA,1) \
1944               BCF(TB,AB,1) BCF(TC,AC,1) BCF(TD,AD,1) BCF(TE,AE,1)              \
1945            SCF(T1,LN,1,A1)  SCF(T2,LN,2,A2)  SCF(T3,LN,3,A3)  SCF(T4,LN,4,A4)  \
1946            SCF(T5,LN,5,A5)  SCF(T6,LN,6,A6)  SCF(T7,LN,7,A7)  SCF(T8,LN,8,A8)  \
1947            SCF(T9,LN,9,A9)  SCF(TA,LN,10,AA) SCF(TB,LN,11,AB) SCF(TC,LN,12,AC) \
1948            SCF(TD,LN,13,AD) SCF(TE,LN,14,AE))))
1949
1950 /*  N.B. Create a separate function instead of using (call function, function
1951 value here) because in order to create the variables needed for the input
1952 arg.'s which may be const.'s one has to do the creation within {}, but these
1953 can never be placed within ()'s. Therefore one must create wrapper functions.
1954 gcc, on the other hand may be able to avoid the wrapper functions. */
1955
1956 /* Prototypes are needed to correctly handle the value returned correctly. N.B.
1957 Can only have prototype arg.'s with difficulty, a la G... table since FORTRAN
1958 functions returning strings have extra arg.'s. Don't bother, since this only
1959 causes a compiler warning to come up when one uses FCALLSCFUNn and CCALLSFFUNn
1960 for the same function in the same source code. Something done by the experts in
1961 debugging only.*/
1962
1963 #define PROTOCCALLSFFUN0(F,UN,LN)                                              \
1964 _(F,_cfPU)( CFC_(UN,LN))(CF_NULL_PROTO);                                       \
1965 static _Icf(2,U,F,CFFUN(UN),0)() {_(F,_cfE) _Icf(3,GZ,F,UN,LN) ABSOFT_cf1(F));_(F,_cfX)}
1966
1967 #define PROTOCCALLSFFUN1( T0,UN,LN,T1)                                         \
1968         PROTOCCALLSFFUN5 (T0,UN,LN,T1,CF_0,CF_0,CF_0,CF_0)
1969 #define PROTOCCALLSFFUN2( T0,UN,LN,T1,T2)                                      \
1970         PROTOCCALLSFFUN5 (T0,UN,LN,T1,T2,CF_0,CF_0,CF_0)
1971 #define PROTOCCALLSFFUN3( T0,UN,LN,T1,T2,T3)                                   \
1972         PROTOCCALLSFFUN5 (T0,UN,LN,T1,T2,T3,CF_0,CF_0)
1973 #define PROTOCCALLSFFUN4( T0,UN,LN,T1,T2,T3,T4)                                \
1974         PROTOCCALLSFFUN5 (T0,UN,LN,T1,T2,T3,T4,CF_0)
1975 #define PROTOCCALLSFFUN5( T0,UN,LN,T1,T2,T3,T4,T5)                             \
1976         PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0)
1977 #define PROTOCCALLSFFUN6( T0,UN,LN,T1,T2,T3,T4,T5,T6)                          \
1978         PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0)
1979 #define PROTOCCALLSFFUN7( T0,UN,LN,T1,T2,T3,T4,T5,T6,T7)                       \
1980         PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0)
1981 #define PROTOCCALLSFFUN8( T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8)                    \
1982         PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0)
1983 #define PROTOCCALLSFFUN9( T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9)                 \
1984         PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0)
1985 #define PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA)              \
1986         PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0)
1987 #define PROTOCCALLSFFUN11(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB)           \
1988         PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0)
1989 #define PROTOCCALLSFFUN12(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC)        \
1990         PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0)
1991 #define PROTOCCALLSFFUN13(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD)     \
1992         PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0)
1993
1994 /* HP/UX 9.01 cc requires the blank between '_Icf(3,G,T0,UN,LN) CCCF(T1,1,0)' */
1995
1996 #ifndef __CF__KnR
1997 #define PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)  \
1998  _(T0,_cfPU)(CFC_(UN,LN))(CF_NULL_PROTO); static _Icf(2,U,T0,CFFUN(UN),0)(     \
1999    CFARGT14FS(UCF,HCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) )          \
2000 {       CFARGT14S(VCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)    _(T0,_cfE) \
2001  CCF(LN,T1,1)  CCF(LN,T2,2)  CCF(LN,T3,3)  CCF(LN,T4,4)  CCF(LN,T5,5)          \
2002  CCF(LN,T6,6)  CCF(LN,T7,7)  CCF(LN,T8,8)  CCF(LN,T9,9)  CCF(LN,TA,10)         \
2003  CCF(LN,TB,11) CCF(LN,TC,12) CCF(LN,TD,13) CCF(LN,TE,14)    _Icf(3,G,T0,UN,LN) \
2004  CFARGT14(CCCF,JCF,ABSOFT_cf1(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)); \
2005  WCF(T1,A1,1)   WCF(T2,A2,2)   WCF(T3,A3,3)   WCF(T4,A4,4)  WCF(T5,A5,5)       \
2006  WCF(T6,A6,6)   WCF(T7,A7,7)   WCF(T8,A8,8)   WCF(T9,A9,9)  WCF(TA,A10,10)     \
2007  WCF(TB,A11,11) WCF(TC,A12,12) WCF(TD,A13,13) WCF(TE,A14,14) _(T0,_cfX)}
2008 #else
2009 #define PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)  \
2010  _(T0,_cfPU)(CFC_(UN,LN))(CF_NULL_PROTO); static _Icf(2,U,T0,CFFUN(UN),0)(     \
2011    CFARGT14FS(UUCF,HHCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) )        \
2012  CFARGT14FS(UUUCF,HHHCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) ;        \
2013 {       CFARGT14S(VCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)    _(T0,_cfE) \
2014  CCF(LN,T1,1)  CCF(LN,T2,2)  CCF(LN,T3,3)  CCF(LN,T4,4)  CCF(LN,T5,5)          \
2015  CCF(LN,T6,6)  CCF(LN,T7,7)  CCF(LN,T8,8)  CCF(LN,T9,9)  CCF(LN,TA,10)         \
2016  CCF(LN,TB,11) CCF(LN,TC,12) CCF(LN,TD,13) CCF(LN,TE,14)    _Icf(3,G,T0,UN,LN) \
2017  CFARGT14(CCCF,JCF,ABSOFT_cf1(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)); \
2018  WCF(T1,A1,1)   WCF(T2,A2,2)   WCF(T3,A3,3)   WCF(T4,A4,4)   WCF(T5,A5,5)      \
2019  WCF(T6,A6,6)   WCF(T7,A7,7)   WCF(T8,A8,8)   WCF(T9,A9,9)   WCF(TA,A10,10)    \
2020  WCF(TB,A11,11) WCF(TC,A12,12) WCF(TD,A13,13) WCF(TE,A14,14) _(T0,_cfX)}
2021 #endif
2022
2023 /*-------------------------------------------------------------------------*/
2024
2025 /*               UTILITIES FOR FORTRAN TO CALL C ROUTINES                  */
2026
2027 #ifdef OLD_VAXC                                /* Prevent %CC-I-PARAMNOTUSED. */
2028 #pragma nostandard
2029 #endif
2030
2031 #if defined(vmsFortran) || defined(CRAYFortran)
2032 #define   DCF(TN,I)
2033 #define  DDCF(TN,I)
2034 #define DDDCF(TN,I)
2035 #else
2036 #define   DCF(TN,I)          HCF(TN,I)
2037 #define  DDCF(TN,I)         HHCF(TN,I)
2038 #define DDDCF(TN,I)        HHHCF(TN,I)
2039 #endif
2040
2041 #define QCF(TN,I)       _(TN,_cfSTR)(1,Q,_(B,I), 0,0,0,0)
2042 #define  DEFAULT_cfQ(B)
2043 #define  LOGICAL_cfQ(B)
2044 #define PLOGICAL_cfQ(B)
2045 #define  STRINGV_cfQ(B) char *B; unsigned int _(B,N);
2046 #define   STRING_cfQ(B) char *B=NULL;
2047 #define  PSTRING_cfQ(B) char *B=NULL;
2048 #define PSTRINGV_cfQ(B) STRINGV_cfQ(B)
2049 #define PNSTRING_cfQ(B) char *B=NULL;
2050 #define PPSTRING_cfQ(B)
2051
2052 #ifdef     __sgi   /* Else SGI gives warning 182 contrary to its C LRM A.17.7 */
2053 #define ROUTINE_orig    *(void**)&
2054 #else
2055 #define ROUTINE_orig     (void *)
2056 #endif
2057
2058 #define ROUTINE_1     ROUTINE_orig
2059 #define ROUTINE_2     ROUTINE_orig
2060 #define ROUTINE_3     ROUTINE_orig
2061 #define ROUTINE_4     ROUTINE_orig
2062 #define ROUTINE_5     ROUTINE_orig
2063 #define ROUTINE_6     ROUTINE_orig
2064 #define ROUTINE_7     ROUTINE_orig
2065 #define ROUTINE_8     ROUTINE_orig
2066 #define ROUTINE_9     ROUTINE_orig
2067 #define ROUTINE_10    ROUTINE_orig
2068 #define ROUTINE_11    ROUTINE_orig
2069 #define ROUTINE_12    ROUTINE_orig
2070 #define ROUTINE_13    ROUTINE_orig
2071 #define ROUTINE_14    ROUTINE_orig
2072 #define ROUTINE_15    ROUTINE_orig
2073 #define ROUTINE_16    ROUTINE_orig
2074 #define ROUTINE_17    ROUTINE_orig
2075 #define ROUTINE_18    ROUTINE_orig
2076 #define ROUTINE_19    ROUTINE_orig
2077 #define ROUTINE_20    ROUTINE_orig
2078 #define ROUTINE_21    ROUTINE_orig
2079 #define ROUTINE_22    ROUTINE_orig
2080 #define ROUTINE_23    ROUTINE_orig
2081 #define ROUTINE_24    ROUTINE_orig
2082 #define ROUTINE_25    ROUTINE_orig
2083 #define ROUTINE_26    ROUTINE_orig
2084 #define ROUTINE_27    ROUTINE_orig
2085
2086 #define TCF(NAME,TN,I,M)              _SEP_(TN,M,cfCOMMA) _(TN,_cfT)(NAME,I,_(A,I),_(B,I),_(C,I))
2087 #define           BYTE_cfT(M,I,A,B,D) *A
2088 #define         DOUBLE_cfT(M,I,A,B,D) *A
2089 #define          FLOAT_cfT(M,I,A,B,D) *A
2090 #define            INT_cfT(M,I,A,B,D) *A
2091 #define        LOGICAL_cfT(M,I,A,B,D)  F2CLOGICAL(*A)
2092 #define           LONG_cfT(M,I,A,B,D) *A
2093 #define       LONGLONG_cfT(M,I,A,B,D) *A /* added by MR December 2005 */
2094 #define          SHORT_cfT(M,I,A,B,D) *A
2095 #define          BYTEV_cfT(M,I,A,B,D)  A
2096 #define        DOUBLEV_cfT(M,I,A,B,D)  A
2097 #define         FLOATV_cfT(M,I,A,B,D)  VOIDP A
2098 #define           INTV_cfT(M,I,A,B,D)  A
2099 #define       LOGICALV_cfT(M,I,A,B,D)  A
2100 #define          LONGV_cfT(M,I,A,B,D)  A
2101 #define      LONGLONGV_cfT(M,I,A,B,D)  A /* added by MR December 2005 */
2102 #define         SHORTV_cfT(M,I,A,B,D)  A
2103 #define         BYTEVV_cfT(M,I,A,B,D)  (void *)A /* We have to cast to void *,*/
2104 #define        BYTEVVV_cfT(M,I,A,B,D)  (void *)A /* since we don't know the   */
2105 #define       BYTEVVVV_cfT(M,I,A,B,D)  (void *)A /* dimensions of the array.  */
2106 #define      BYTEVVVVV_cfT(M,I,A,B,D)  (void *)A /* i.e. Unfortunately, can't */
2107 #define     BYTEVVVVVV_cfT(M,I,A,B,D)  (void *)A /* check that the type       */
2108 #define    BYTEVVVVVVV_cfT(M,I,A,B,D)  (void *)A /* matches the prototype.    */
2109 #define       DOUBLEVV_cfT(M,I,A,B,D)  (void *)A
2110 #define      DOUBLEVVV_cfT(M,I,A,B,D)  (void *)A
2111 #define     DOUBLEVVVV_cfT(M,I,A,B,D)  (void *)A
2112 #define    DOUBLEVVVVV_cfT(M,I,A,B,D)  (void *)A
2113 #define   DOUBLEVVVVVV_cfT(M,I,A,B,D)  (void *)A
2114 #define  DOUBLEVVVVVVV_cfT(M,I,A,B,D)  (void *)A
2115 #define        FLOATVV_cfT(M,I,A,B,D)  (void *)A
2116 #define       FLOATVVV_cfT(M,I,A,B,D)  (void *)A
2117 #define      FLOATVVVV_cfT(M,I,A,B,D)  (void *)A
2118 #define     FLOATVVVVV_cfT(M,I,A,B,D)  (void *)A
2119 #define    FLOATVVVVVV_cfT(M,I,A,B,D)  (void *)A
2120 #define   FLOATVVVVVVV_cfT(M,I,A,B,D)  (void *)A
2121 #define          INTVV_cfT(M,I,A,B,D)  (void *)A
2122 #define         INTVVV_cfT(M,I,A,B,D)  (void *)A
2123 #define        INTVVVV_cfT(M,I,A,B,D)  (void *)A
2124 #define       INTVVVVV_cfT(M,I,A,B,D)  (void *)A
2125 #define      INTVVVVVV_cfT(M,I,A,B,D)  (void *)A
2126 #define     INTVVVVVVV_cfT(M,I,A,B,D)  (void *)A
2127 #define      LOGICALVV_cfT(M,I,A,B,D)  (void *)A
2128 #define     LOGICALVVV_cfT(M,I,A,B,D)  (void *)A
2129 #define    LOGICALVVVV_cfT(M,I,A,B,D)  (void *)A
2130 #define   LOGICALVVVVV_cfT(M,I,A,B,D)  (void *)A
2131 #define  LOGICALVVVVVV_cfT(M,I,A,B,D)  (void *)A
2132 #define LOGICALVVVVVVV_cfT(M,I,A,B,D)  (void *)A
2133 #define         LONGVV_cfT(M,I,A,B,D)  (void *)A
2134 #define        LONGVVV_cfT(M,I,A,B,D)  (void *)A
2135 #define       LONGVVVV_cfT(M,I,A,B,D)  (void *)A
2136 #define      LONGVVVVV_cfT(M,I,A,B,D)  (void *)A
2137 #define     LONGVVVVVV_cfT(M,I,A,B,D)  (void *)A
2138 #define    LONGVVVVVVV_cfT(M,I,A,B,D)  (void *)A
2139 #define     LONGLONGVV_cfT(M,I,A,B,D)  (void *)A /* added by MR December 2005 */
2140 #define    LONGLONGVVV_cfT(M,I,A,B,D)  (void *)A /* added by MR December 2005 */
2141 #define   LONGLONGVVVV_cfT(M,I,A,B,D)  (void *)A /* added by MR December 2005 */
2142 #define  LONGLONGVVVVV_cfT(M,I,A,B,D)  (void *)A /* added by MR December 2005 */
2143 #define LONGLONGVVVVVV_cfT(M,I,A,B,D)  (void *)A /* added by MR December 2005 */
2144 #define LONGLONGVVVVVVV_cfT(M,I,A,B,D)  (void *)A /* added by MR December 2005 */
2145 #define        SHORTVV_cfT(M,I,A,B,D)  (void *)A
2146 #define       SHORTVVV_cfT(M,I,A,B,D)  (void *)A
2147 #define      SHORTVVVV_cfT(M,I,A,B,D)  (void *)A
2148 #define     SHORTVVVVV_cfT(M,I,A,B,D)  (void *)A
2149 #define    SHORTVVVVVV_cfT(M,I,A,B,D)  (void *)A
2150 #define   SHORTVVVVVVV_cfT(M,I,A,B,D)  (void *)A
2151 #define          PBYTE_cfT(M,I,A,B,D)  A
2152 #define        PDOUBLE_cfT(M,I,A,B,D)  A
2153 #define         PFLOAT_cfT(M,I,A,B,D)  VOIDP A
2154 #define           PINT_cfT(M,I,A,B,D)  A
2155 #define       PLOGICAL_cfT(M,I,A,B,D)  ((*A=F2CLOGICAL(*A)),A)
2156 #define          PLONG_cfT(M,I,A,B,D)  A
2157 #define      PLONGLONG_cfT(M,I,A,B,D)  A /* added by MR December 2005 */
2158 #define         PSHORT_cfT(M,I,A,B,D)  A
2159 #define          PVOID_cfT(M,I,A,B,D)  A
2160 #if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran)
2161 #define        ROUTINE_cfT(M,I,A,B,D)  _(ROUTINE_,I)  (*A)
2162 #else
2163 #define        ROUTINE_cfT(M,I,A,B,D)  _(ROUTINE_,I)    A
2164 #endif
2165 /* A == pointer to the characters
2166    D == length of the string, or of an element in an array of strings
2167    E == number of elements in an array of strings                             */
2168 #define TTSTR(    A,B,D)                                                       \
2169            ((B=_cf_malloc(D+1))[D]='\0', memcpy(B,A,D), kill_trailing(B,' '))
2170 #define TTTTSTR(  A,B,D)   (!(D<4||A[0]||A[1]||A[2]||A[3]))?NULL:              \
2171                             memchr(A,'\0',D)                 ?A   : TTSTR(A,B,D)
2172 #define TTTTSTRV( A,B,D,E) (_(B,N)=E,B=_cf_malloc(_(B,N)*(D+1)), (void *)      \
2173   vkill_trailing(f2cstrv(A,B,D+1, _(B,N)*(D+1)), D+1,_(B,N)*(D+1),' '))
2174 #ifdef vmsFortran
2175 #define         STRING_cfT(M,I,A,B,D)  TTTTSTR( A->dsc$a_pointer,B,A->dsc$w_length)
2176 #define        STRINGV_cfT(M,I,A,B,D)  TTTTSTRV(A->dsc$a_pointer, B,           \
2177                                              A->dsc$w_length , A->dsc$l_m[0])
2178 #define        PSTRING_cfT(M,I,A,B,D)    TTSTR( A->dsc$a_pointer,B,A->dsc$w_length)
2179 #define       PPSTRING_cfT(M,I,A,B,D)           A->dsc$a_pointer
2180 #else
2181 #ifdef CRAYFortran
2182 #define         STRING_cfT(M,I,A,B,D)  TTTTSTR( _fcdtocp(A),B,_fcdlen(A))
2183 #define        STRINGV_cfT(M,I,A,B,D)  TTTTSTRV(_fcdtocp(A),B,_fcdlen(A),      \
2184                               num_elem(_fcdtocp(A),_fcdlen(A),_3(M,_STRV_A,I)))
2185 #define        PSTRING_cfT(M,I,A,B,D)    TTSTR( _fcdtocp(A),B,_fcdlen(A))
2186 #define       PPSTRING_cfT(M,I,A,B,D)           _fcdtocp(A)
2187 #else
2188 #define         STRING_cfT(M,I,A,B,D)  TTTTSTR( A,B,D)
2189 #define        STRINGV_cfT(M,I,A,B,D)  TTTTSTRV(A,B,D, num_elem(A,D,_3(M,_STRV_A,I)))
2190 #define        PSTRING_cfT(M,I,A,B,D)    TTSTR( A,B,D)
2191 #define       PPSTRING_cfT(M,I,A,B,D)           A
2192 #endif
2193 #endif
2194 #define       PNSTRING_cfT(M,I,A,B,D)    STRING_cfT(M,I,A,B,D)
2195 #define       PSTRINGV_cfT(M,I,A,B,D)   STRINGV_cfT(M,I,A,B,D)
2196 #define           CF_0_cfT(M,I,A,B,D)
2197
2198 #define RCF(TN,I)           _(TN,_cfSTR)(3,R,_(A,I),_(B,I),_(C,I),0,0)
2199 #define  DEFAULT_cfR(A,B,D)
2200 #define  LOGICAL_cfR(A,B,D)
2201 #define PLOGICAL_cfR(A,B,D) *A=C2FLOGICAL(*A);
2202 #define   STRING_cfR(A,B,D) if (B) _cf_free(B);
2203 #define  STRINGV_cfR(A,B,D) _cf_free(B);
2204 /* A and D as defined above for TSTRING(V) */
2205 #define RRRRPSTR( A,B,D)    if (B) memcpy(A,B, _cfMIN(strlen(B),D)),           \
2206                   (D>strlen(B)?memset(A+strlen(B),' ', D-strlen(B)):0), _cf_free(B);
2207 #define RRRRPSTRV(A,B,D)    c2fstrv(B,A,D+1,(D+1)*_(B,N)), _cf_free(B);
2208 #ifdef vmsFortran
2209 #define  PSTRING_cfR(A,B,D) RRRRPSTR( A->dsc$a_pointer,B,A->dsc$w_length)
2210 #define PSTRINGV_cfR(A,B,D) RRRRPSTRV(A->dsc$a_pointer,B,A->dsc$w_length)
2211 #else
2212 #ifdef CRAYFortran
2213 #define  PSTRING_cfR(A,B,D) RRRRPSTR( _fcdtocp(A),B,_fcdlen(A))
2214 #define PSTRINGV_cfR(A,B,D) RRRRPSTRV(_fcdtocp(A),B,_fcdlen(A))
2215 #else
2216 #define  PSTRING_cfR(A,B,D) RRRRPSTR( A,B,D)
2217 #define PSTRINGV_cfR(A,B,D) RRRRPSTRV(A,B,D)
2218 #endif
2219 #endif
2220 #define PNSTRING_cfR(A,B,D) PSTRING_cfR(A,B,D)
2221 #define PPSTRING_cfR(A,B,D)
2222
2223 #define    BYTE_cfFZ(UN,LN) INTEGER_BYTE     FCALLSC_QUALIFIER fcallsc(UN,LN)(
2224 #define  DOUBLE_cfFZ(UN,LN) DOUBLE_PRECISION FCALLSC_QUALIFIER fcallsc(UN,LN)(
2225 #define     INT_cfFZ(UN,LN) int   FCALLSC_QUALIFIER fcallsc(UN,LN)(
2226 #define LOGICAL_cfFZ(UN,LN) int   FCALLSC_QUALIFIER fcallsc(UN,LN)(
2227 #define    LONG_cfFZ(UN,LN) long  FCALLSC_QUALIFIER fcallsc(UN,LN)(
2228 #define LONGLONG_cfFZ(UN,LN) LONGLONG FCALLSC_QUALIFIER fcallsc(UN,LN)( /* added by MR December 2005 */
2229 #define   SHORT_cfFZ(UN,LN) short FCALLSC_QUALIFIER fcallsc(UN,LN)(
2230 #define    VOID_cfFZ(UN,LN) void  FCALLSC_QUALIFIER fcallsc(UN,LN)(
2231 #ifndef __CF__KnR
2232 /* The void is req'd by the Apollo, to make this an ANSI function declaration.
2233    The Apollo promotes K&R float functions to double. */
2234 #if defined (f2cFortran) && ! defined (gFortran)
2235 /* f2c/g77 return double from FORTRAN REAL functions. (KMCCARTY, 2005/12/09) */
2236 #define FLOAT_cfFZ(UN,LN) DOUBLE_PRECISION FCALLSC_QUALIFIER fcallsc(UN,LN)(void
2237 #else
2238 #define FLOAT_cfFZ(UN,LN) FORTRAN_REAL FCALLSC_QUALIFIER fcallsc(UN,LN)(void
2239 #endif
2240 #ifdef vmsFortran
2241 #define  STRING_cfFZ(UN,LN) void  FCALLSC_QUALIFIER fcallsc(UN,LN)(fstring *AS
2242 #else
2243 #ifdef CRAYFortran
2244 #define  STRING_cfFZ(UN,LN) void  FCALLSC_QUALIFIER fcallsc(UN,LN)(_fcd     AS
2245 #else
2246 #if  defined(AbsoftUNIXFortran) || defined(AbsoftProFortran)
2247 #define  STRING_cfFZ(UN,LN) void  FCALLSC_QUALIFIER fcallsc(UN,LN)(char    *AS
2248 #else
2249 #define  STRING_cfFZ(UN,LN) void  FCALLSC_QUALIFIER fcallsc(UN,LN)(char    *AS, unsigned D0
2250 #endif
2251 #endif
2252 #endif
2253 #else
2254 #if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT))
2255 #if defined (f2cFortran) && ! defined (gFortran)
2256 /* f2c/g77 return double from FORTRAN REAL functions. (KMCCARTY, 2005/12/09) */
2257 #define   FLOAT_cfFZ(UN,LN) DOUBLE_PRECISION  FCALLSC_QUALIFIER fcallsc(UN,LN)(
2258 #else
2259 #define   FLOAT_cfFZ(UN,LN) FORTRAN_REAL      FCALLSC_QUALIFIER fcallsc(UN,LN)(
2260 #endif
2261 #else
2262 #define   FLOAT_cfFZ(UN,LN) FLOATFUNCTIONTYPE FCALLSC_QUALIFIER fcallsc(UN,LN)(
2263 #endif
2264 #if defined(vmsFortran) || defined(CRAYFortran) || defined(AbsoftUNIXFortran)
2265 #define  STRING_cfFZ(UN,LN) void  FCALLSC_QUALIFIER fcallsc(UN,LN)(AS
2266 #else
2267 #define  STRING_cfFZ(UN,LN) void  FCALLSC_QUALIFIER fcallsc(UN,LN)(AS, D0
2268 #endif
2269 #endif
2270
2271 #define    BYTE_cfF(UN,LN)     BYTE_cfFZ(UN,LN)
2272 #define  DOUBLE_cfF(UN,LN)   DOUBLE_cfFZ(UN,LN)
2273 #ifndef __CF_KnR
2274 #if defined (f2cFortran) && ! defined (gFortran)
2275 /* f2c/g77 return double from FORTRAN REAL functions. (KMCCARTY, 2005/12/09) */
2276 #define   FLOAT_cfF(UN,LN)  DOUBLE_PRECISION FCALLSC_QUALIFIER fcallsc(UN,LN)(
2277 #else
2278 #define   FLOAT_cfF(UN,LN)  FORTRAN_REAL FCALLSC_QUALIFIER fcallsc(UN,LN)(
2279 #endif
2280 #else
2281 #define   FLOAT_cfF(UN,LN)    FLOAT_cfFZ(UN,LN)
2282 #endif
2283 #define     INT_cfF(UN,LN)      INT_cfFZ(UN,LN)
2284 #define LOGICAL_cfF(UN,LN)  LOGICAL_cfFZ(UN,LN)
2285 #define    LONG_cfF(UN,LN)     LONG_cfFZ(UN,LN)
2286 #define LONGLONG_cfF(UN,LN) LONGLONG_cfFZ(UN,LN) /* added by MR December 2005 */
2287 #define   SHORT_cfF(UN,LN)    SHORT_cfFZ(UN,LN)
2288 #define    VOID_cfF(UN,LN)     VOID_cfFZ(UN,LN)
2289 #define  STRING_cfF(UN,LN)   STRING_cfFZ(UN,LN),
2290
2291 #define     INT_cfFF
2292 #define    VOID_cfFF
2293 #ifdef vmsFortran
2294 #define  STRING_cfFF           fstring *AS;
2295 #else
2296 #ifdef CRAYFortran
2297 #define  STRING_cfFF           _fcd     AS;
2298 #else
2299 #define  STRING_cfFF           char    *AS; unsigned D0;
2300 #endif
2301 #endif
2302
2303 #define     INT_cfL            A0=
2304 #define  STRING_cfL            A0=
2305 #define    VOID_cfL
2306
2307 #define    INT_cfK
2308 #define   VOID_cfK
2309 /* KSTRING copies the string into the position provided by the caller. */
2310 #ifdef vmsFortran
2311 #define STRING_cfK                                                             \
2312  memcpy(AS->dsc$a_pointer,A0,_cfMIN(AS->dsc$w_length,(A0==NULL?0:strlen(A0))));\
2313  AS->dsc$w_length>(A0==NULL?0:strlen(A0))?                                     \
2314   memset(AS->dsc$a_pointer+(A0==NULL?0:strlen(A0)),' ',                        \
2315          AS->dsc$w_length-(A0==NULL?0:strlen(A0))):0;
2316 #else
2317 #ifdef CRAYFortran
2318 #define STRING_cfK                                                             \
2319  memcpy(_fcdtocp(AS),A0, _cfMIN(_fcdlen(AS),(A0==NULL?0:strlen(A0))) );        \
2320  _fcdlen(AS)>(A0==NULL?0:strlen(A0))?                                          \
2321   memset(_fcdtocp(AS)+(A0==NULL?0:strlen(A0)),' ',                             \
2322          _fcdlen(AS)-(A0==NULL?0:strlen(A0))):0;
2323 #else
2324 #define STRING_cfK         memcpy(AS,A0, _cfMIN(D0,(A0==NULL?0:strlen(A0))) ); \
2325                  D0>(A0==NULL?0:strlen(A0))?memset(AS+(A0==NULL?0:strlen(A0)), \
2326                                             ' ', D0-(A0==NULL?0:strlen(A0))):0;
2327 #endif
2328 #endif
2329
2330 /* Note that K.. and I.. can't be combined since K.. has to access data before
2331 R.., in order for functions returning strings which are also passed in as
2332 arguments to work correctly. Note that R.. frees and hence may corrupt the
2333 string. */
2334 #define    BYTE_cfI  return A0;
2335 #define  DOUBLE_cfI  return A0;
2336 #if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT))
2337 #define   FLOAT_cfI  return A0;
2338 #else
2339 #define   FLOAT_cfI  RETURNFLOAT(A0);
2340 #endif
2341 #define     INT_cfI  return A0;
2342 #ifdef hpuxFortran800
2343 /* Incredibly, functions must return true as 1, elsewhere .true.==0x01000000. */
2344 #define LOGICAL_cfI  return ((A0)?1:0);
2345 #else
2346 #define LOGICAL_cfI  return C2FLOGICAL(A0);
2347 #endif
2348 #define    LONG_cfI  return A0;
2349 #define LONGLONG_cfI  return A0; /* added by MR December 2005 */
2350 #define   SHORT_cfI  return A0;
2351 #define  STRING_cfI  return   ;
2352 #define    VOID_cfI  return   ;
2353
2354 #ifdef OLD_VAXC                                  /* Allow %CC-I-PARAMNOTUSED. */
2355 #pragma standard
2356 #endif
2357
2358 #define FCALLSCSUB0( CN,UN,LN)             FCALLSCFUN0(VOID,CN,UN,LN)
2359 #define FCALLSCSUB1( CN,UN,LN,T1)          FCALLSCFUN1(VOID,CN,UN,LN,T1)
2360 #define FCALLSCSUB2( CN,UN,LN,T1,T2)       FCALLSCFUN2(VOID,CN,UN,LN,T1,T2)
2361 #define FCALLSCSUB3( CN,UN,LN,T1,T2,T3)    FCALLSCFUN3(VOID,CN,UN,LN,T1,T2,T3)
2362 #define FCALLSCSUB4( CN,UN,LN,T1,T2,T3,T4) \
2363     FCALLSCFUN4(VOID,CN,UN,LN,T1,T2,T3,T4)
2364 #define FCALLSCSUB5( CN,UN,LN,T1,T2,T3,T4,T5) \
2365     FCALLSCFUN5(VOID,CN,UN,LN,T1,T2,T3,T4,T5)
2366 #define FCALLSCSUB6( CN,UN,LN,T1,T2,T3,T4,T5,T6) \
2367     FCALLSCFUN6(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6)
2368 #define FCALLSCSUB7( CN,UN,LN,T1,T2,T3,T4,T5,T6,T7) \
2369     FCALLSCFUN7(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7)
2370 #define FCALLSCSUB8( CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \
2371     FCALLSCFUN8(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8)
2372 #define FCALLSCSUB9( CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \
2373     FCALLSCFUN9(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9)
2374 #define FCALLSCSUB10(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \
2375    FCALLSCFUN10(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA)
2376 #define FCALLSCSUB11(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \
2377    FCALLSCFUN11(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB)
2378 #define FCALLSCSUB12(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \
2379    FCALLSCFUN12(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC)
2380 #define FCALLSCSUB13(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \
2381    FCALLSCFUN13(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD)
2382 #define FCALLSCSUB14(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
2383    FCALLSCFUN14(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
2384 #define FCALLSCSUB15(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF) \
2385    FCALLSCFUN15(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF)
2386 #define FCALLSCSUB16(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG) \
2387    FCALLSCFUN16(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG)
2388 #define FCALLSCSUB17(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH) \
2389    FCALLSCFUN17(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH)
2390 #define FCALLSCSUB18(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI) \
2391    FCALLSCFUN18(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI)
2392 #define FCALLSCSUB19(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ) \
2393    FCALLSCFUN19(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ)
2394 #define FCALLSCSUB20(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \
2395    FCALLSCFUN20(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)
2396 #define FCALLSCSUB21(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL) \
2397    FCALLSCFUN21(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL)
2398 #define FCALLSCSUB22(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM) \
2399    FCALLSCFUN22(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM)
2400 #define FCALLSCSUB23(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN) \
2401    FCALLSCFUN23(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN)
2402 #define FCALLSCSUB24(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO) \
2403    FCALLSCFUN24(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO)
2404 #define FCALLSCSUB25(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP) \
2405    FCALLSCFUN25(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP)
2406 #define FCALLSCSUB26(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ) \
2407    FCALLSCFUN26(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ)
2408 #define FCALLSCSUB27(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
2409    FCALLSCFUN27(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)
2410
2411
2412 #define FCALLSCFUN1( T0,CN,UN,LN,T1) \
2413         FCALLSCFUN5 (T0,CN,UN,LN,T1,CF_0,CF_0,CF_0,CF_0)
2414 #define FCALLSCFUN2( T0,CN,UN,LN,T1,T2) \
2415         FCALLSCFUN5 (T0,CN,UN,LN,T1,T2,CF_0,CF_0,CF_0)
2416 #define FCALLSCFUN3( T0,CN,UN,LN,T1,T2,T3) \
2417         FCALLSCFUN5 (T0,CN,UN,LN,T1,T2,T3,CF_0,CF_0)
2418 #define FCALLSCFUN4( T0,CN,UN,LN,T1,T2,T3,T4) \
2419         FCALLSCFUN5 (T0,CN,UN,LN,T1,T2,T3,T4,CF_0)
2420 #define FCALLSCFUN5( T0,CN,UN,LN,T1,T2,T3,T4,T5) \
2421         FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0)
2422 #define FCALLSCFUN6( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6) \
2423         FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0)
2424 #define FCALLSCFUN7( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7) \
2425         FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0)
2426 #define FCALLSCFUN8( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \
2427         FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0)
2428 #define FCALLSCFUN9( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \
2429         FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0)
2430 #define FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \
2431         FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0)
2432 #define FCALLSCFUN11(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \
2433         FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0)
2434 #define FCALLSCFUN12(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \
2435         FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0)
2436 #define FCALLSCFUN13(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \
2437         FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0)
2438
2439
2440 #define FCALLSCFUN15(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF) \
2441         FCALLSCFUN20(T0,CN,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)
2442 #define FCALLSCFUN16(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG) \
2443         FCALLSCFUN20(T0,CN,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)
2444 #define FCALLSCFUN17(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH) \
2445         FCALLSCFUN20(T0,CN,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)
2446 #define FCALLSCFUN18(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI) \
2447         FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,CF_0,CF_0)
2448 #define FCALLSCFUN19(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ) \
2449         FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,CF_0)
2450 #define FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \
2451         FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
2452 #define FCALLSCFUN21(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL) \
2453         FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
2454 #define FCALLSCFUN22(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM) \
2455         FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,CF_0,CF_0,CF_0,CF_0,CF_0)
2456 #define FCALLSCFUN23(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN) \
2457         FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,CF_0,CF_0,CF_0,CF_0)
2458 #define FCALLSCFUN24(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO) \
2459         FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,CF_0,CF_0,CF_0)
2460 #define FCALLSCFUN25(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP) \
2461         FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,CF_0,CF_0)
2462 #define FCALLSCFUN26(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ) \
2463         FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,CF_0)
2464
2465
2466 #ifndef __CF__KnR
2467 #define FCALLSCFUN0(T0,CN,UN,LN) CFextern _(T0,_cfFZ)(UN,LN) ABSOFT_cf2(T0))   \
2468         {_Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN(); _Icf(0,K,T0,0,0) _(T0,_cfI)}
2469
2470 #define FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)    \
2471                                  CFextern _(T0,_cfF)(UN,LN)                    \
2472  CFARGT14(NCF,DCF,ABSOFT_cf2(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) )  \
2473  {                 CFARGT14S(QCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)    \
2474   _Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0)      CN(    TCF(LN,T1,1,0)  TCF(LN,T2,2,1) \
2475     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) \
2476     TCF(LN,T8,8,1)  TCF(LN,T9,9,1) TCF(LN,TA,10,1) TCF(LN,TB,11,1) TCF(LN,TC,12,1) \
2477     TCF(LN,TD,13,1) TCF(LN,TE,14,1) );                          _Icf(0,K,T0,0,0) \
2478                    CFARGT14S(RCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)  _(T0,_cfI) }
2479
2480 #define FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)   \
2481                                  CFextern _(T0,_cfF)(UN,LN)                    \
2482  CFARGT27(NCF,DCF,ABSOFT_cf2(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) ) \
2483  {                 CFARGT27S(QCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)   \
2484   _Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0)      CN(     TCF(LN,T1,1,0)  TCF(LN,T2,2,1)  \
2485     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)  \
2486     TCF(LN,T8,8,1)  TCF(LN,T9,9,1)  TCF(LN,TA,10,1) TCF(LN,TB,11,1) TCF(LN,TC,12,1) \
2487     TCF(LN,TD,13,1) TCF(LN,TE,14,1) TCF(LN,TF,15,1) TCF(LN,TG,16,1) TCF(LN,TH,17,1) \
2488     TCF(LN,TI,18,1) TCF(LN,TJ,19,1) TCF(LN,TK,20,1) TCF(LN,TL,21,1) TCF(LN,TM,22,1) \
2489     TCF(LN,TN,23,1) TCF(LN,TO,24,1) TCF(LN,TP,25,1) TCF(LN,TQ,26,1) TCF(LN,TR,27,1) ); _Icf(0,K,T0,0,0) \
2490                    CFARGT27S(RCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)  _(T0,_cfI) }
2491
2492 #else
2493 #define FCALLSCFUN0(T0,CN,UN,LN) CFextern _(T0,_cfFZ)(UN,LN) ABSOFT_cf3(T0)) _Icf(0,FF,T0,0,0)\
2494         {_Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN(); _Icf(0,K,T0,0,0) _(T0,_cfI)}
2495
2496 #define FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)    \
2497                                  CFextern _(T0,_cfF)(UN,LN)                    \
2498  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) \
2499        CFARGT14FS(NNNCF,DDDCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE);   \
2500  {                 CFARGT14S(QCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)    \
2501   _Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0)      CN(  TCF(LN,T1,1,0) TCF(LN,T2,2,1) \
2502     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) \
2503     TCF(LN,T8,8,1) TCF(LN,T9,9,1) TCF(LN,TA,10,1) TCF(LN,TB,11,1) TCF(LN,TC,12,1) \
2504     TCF(LN,TD,13,1) TCF(LN,TE,14,1) );                          _Icf(0,K,T0,0,0) \
2505                    CFARGT14S(RCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)  _(T0,_cfI)}
2506
2507 #define FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)  \
2508                                  CFextern _(T0,_cfF)(UN,LN)                    \
2509  CFARGT27(NNCF,DDCF,ABSOFT_cf3(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)) _Icf(0,FF,T0,0,0) \
2510        CFARGT27FS(NNNCF,DDDCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR); \
2511  {                 CFARGT27S(QCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)  \
2512   _Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0)      CN(     TCF(LN,T1,1,0)  TCF(LN,T2,2,1)  \
2513     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)  \
2514     TCF(LN,T8,8,1)  TCF(LN,T9,9,1)  TCF(LN,TA,10,1) TCF(LN,TB,11,1) TCF(LN,TC,12,1) \
2515     TCF(LN,TD,13,1) TCF(LN,TE,14,1) TCF(LN,TF,15,1) TCF(LN,TG,16,1) TCF(LN,TH,17,1) \
2516     TCF(LN,TI,18,1) TCF(LN,TJ,19,1) TCF(LN,TK,20,1) TCF(LN,TL,21,1) TCF(LN,TM,22,1) \
2517     TCF(LN,TN,23,1) TCF(LN,TO,24,1) TCF(LN,TP,25,1) TCF(LN,TQ,26,1) TCF(LN,TR,27,1) ); _Icf(0,K,T0,0,0) \
2518                    CFARGT27S(RCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)  _(T0,_cfI)}
2519
2520 #endif
2521
2522
2523 #endif    /* __CFORTRAN_LOADED */