Back to home page

EIC code displayed by LXR

 
 

    


File indexing completed on 2024-05-18 08:29:41

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