cfortran.h
Go to the documentation of this file.
1 //LIC// ====================================================================
2 //LIC// This file forms part of oomph-lib, the object-oriented,
3 //LIC// multi-physics finite-element library, available
4 //LIC// at http://www.oomph-lib.org.
5 //LIC//
6 //LIC// Version 1.0; svn revision $LastChangedRevision$
7 //LIC//
8 //LIC// $LastChangedDate$
9 //LIC//
10 //LIC// Copyright (C) 2006-2016 Matthias Heil and Andrew Hazel
11 //LIC//
12 //LIC// This library is free software; you can redistribute it and/or
13 //LIC// modify it under the terms of the GNU Lesser General Public
14 //LIC// License as published by the Free Software Foundation; either
15 //LIC// version 2.1 of the License, or (at your option) any later version.
16 //LIC//
17 //LIC// This library is distributed in the hope that it will be useful,
18 //LIC// but WITHOUT ANY WARRANTY; without even the implied warranty of
19 //LIC// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
20 //LIC// Lesser General Public License for more details.
21 //LIC//
22 //LIC// You should have received a copy of the GNU Lesser General Public
23 //LIC// License along with this library; if not, write to the Free Software
24 //LIC// Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
25 //LIC// 02110-1301 USA.
26 //LIC//
27 //LIC// The authors may be contacted at oomph-lib@maths.man.ac.uk.
28 //LIC//
29 //LIC//====================================================================
30 /* cfortran.h 4.4.1 */
31 /* http://www-zeus.desy.de/~burow/cfortran/ */
32 /* Burkhard Burow burow@desy.de 1990 - 2002. */
33 
34 #ifndef __CFORTRAN_LOADED
35 #define __CFORTRAN_LOADED
36 
37 /*
38  THIS FILE IS PROPERTY OF BURKHARD BUROW. IF YOU ARE USING THIS FILE YOU
39  SHOULD ALSO HAVE ACCESS TO CFORTRAN.DOC WHICH PROVIDES TERMS FOR USING,
40  MODIFYING, COPYING AND DISTRIBUTING THE CFORTRAN.H PACKAGE.
41 */
42 
43 /* The following modifications were made by the authors of CFITSIO or by me.
44  * They are flagged below with CFITSIO, the author's initials, or KMCCARTY.
45  * PDW = Peter Wilson
46  * DM = Doug Mink
47  * LEB = Lee E Brotzman
48  * MR = Martin Reinecke
49  * WDP = William D Pence
50  * -- Kevin McCarty, for Debian (19 Dec. 2005) */
51 
52 /*******
53  Modifications:
54  Oct 1997: Changed symbol name extname to appendus (PDW/HSTX)
55  (Conflicted with a common variable name in FTOOLS)
56  Nov 1997: If g77Fortran defined, also define f2cFortran (PDW/HSTX)
57  Feb 1998: Let VMS see the NUM_ELEMS code. Lets programs treat
58  single strings as vectors with single elements
59  Nov 1999: If macintoxh defined, also define f2cfortran (for Mac OS-X)
60  Apr 2000: If WIN32 defined, also define PowerStationFortran and
61  VISUAL_CPLUSPLUS (Visual C++)
62  Jun 2000: If __GNUC__ and linux defined, also define f2cFortran
63  (linux/gcc environment detection)
64  Apr 2002: If __CYGWIN__ is defined, also define f2cFortran
65  Nov 2002: If __APPLE__ defined, also define f2cfortran (for Mac OS-X)
66 
67  Nov 2003: If __INTEL_COMPILER or INTEL_COMPILER defined, also define
68  f2cFortran (KMCCARTY)
69  Dec 2005: If f2cFortran is defined, enforce REAL functions in FORTRAN
70  returning "double" in C. This was one of the items on
71  Burkhard's TODO list. (KMCCARTY)
72  Dec 2005: Modifications to support 8-byte integers. (MR)
73  USE AT YOUR OWN RISK!
74  Feb 2006 Added logic to typedef the symbol 'LONGLONG' to an appropriate
75  intrinsic 8-byte integer datatype (WDP)
76  Apr 2006: Modifications to support gfortran (and g77 with -fno-f2c flag)
77  since by default it returns "float" for FORTRAN REAL function.
78  (KMCCARTY)
79  May 2008: Modified name of DOUBLE_PRECISION macro to avoid a
80  nameclash with certain MPI
81  implementations. (A Hazel)
82  *******/
83 
84 /*
85  Avoid symbols already used by compilers and system *.h:
86  __ - OSF1 zukal06 V3.0 347 alpha, cc -c -std1 cfortest.c
87 
88 */
89 
90 /*
91  Determine what 8-byte integer data type is available.
92  'long long' is now supported by most compilers, but older
93  MS Visual C++ compilers before V7.0 use '__int64' instead. (WDP)
94 */
95 
96 #ifndef LONGLONG_TYPE /* this may have been previously defined */
97 #if defined(_MSC_VER) /* Microsoft Visual C++ */
98 
99 #if (_MSC_VER < 1300) /* versions earlier than V7.0 do not have 'long long' */
100  typedef __int64 LONGLONG;
101 #else /* newer versions do support 'long long' */
102  typedef long long LONGLONG;
103 #endif
104 
105 #else
106  typedef long long LONGLONG;
107 #endif
108 
109 #define LONGLONG_TYPE
110 #endif
111 
112 
113 /* First prepare for the C compiler. */
114 
115 #ifndef ANSI_C_preprocessor /* i.e. user can override. */
116 #ifdef __CF__KnR
117 #define ANSI_C_preprocessor 0
118 #else
119 #ifdef __STDC__
120 #define ANSI_C_preprocessor 1
121 #else
122 #define _cfleft 1
123 #define _cfright
124 #define _cfleft_cfright 0
125 #define ANSI_C_preprocessor _cfleft/**/_cfright
126 #endif
127 #endif
128 #endif
129 
130 #if ANSI_C_preprocessor
131 #define _0(A,B) A##B
132 #define _(A,B) _0(A,B) /* see cat,xcat of K&R ANSI C p. 231 */
133 #define _2(A,B) A##B /* K&R ANSI C p.230: .. identifier is not replaced */
134 #define _3(A,B,C) _(A,_(B,C))
135 #else /* if it turns up again during rescanning. */
136 #define _(A,B) A/**/B
137 #define _2(A,B) A/**/B
138 #define _3(A,B,C) A/**/B/**/C
139 #endif
140 
141 #if (defined(vax)&&defined(unix)) || (defined(__vax__)&&defined(__unix__))
142 #define VAXUltrix
143 #endif
144 
145 #include <stdio.h> /* NULL [in all machines stdio.h] */
146 #include <string.h> /* strlen, memset, memcpy, memchr. */
147 #if !( defined(VAXUltrix) || defined(sun) || (defined(apollo)&&!defined(__STDCPP__)) )
148 #include <stdlib.h> /* malloc,free */
149 #else
150 #include <malloc.h> /* Had to be removed for DomainOS h105 10.4 sys5.3 425t*/
151 #ifdef apollo
152 #define __CF__APOLLO67 /* __STDCPP__ is in Apollo 6.8 (i.e. ANSI) and onwards */
153 #endif
154 #endif
155 
156 #if !defined(__GNUC__) && !defined(__sun) && (defined(sun)||defined(VAXUltrix)||defined(lynx))
157 #define __CF__KnR /* Sun, LynxOS and VAX Ultrix cc only supports K&R. */
158  /* Manually define __CF__KnR for HP if desired/required.*/
159 #endif /* i.e. We will generate Kernighan and Ritchie C. */
160 /* Note that you may define __CF__KnR before #include cfortran.h, in order to
161 generate K&R C instead of the default ANSI C. The differences are mainly in the
162 function prototypes and declarations. All machines, except the Apollo, work
163 with either style. The Apollo's argument promotion rules require ANSI or use of
164 the obsolete std_$call which we have not implemented here. Hence on the Apollo,
165 only C calling FORTRAN subroutines will work using K&R style.*/
166 
167 
168 /* Remainder of cfortran.h depends on the Fortran compiler. */
169 
170 /* 11/29/2003 (KMCCARTY): add *INTEL_COMPILER symbols here */
171 /* 04/05/2006 (KMCCARTY): add gFortran symbol here */
172 #if defined(CLIPPERFortran) || defined(pgiFortran) || defined(__INTEL_COMPILER) || defined(INTEL_COMPILER) || defined(gFortran)
173 #define f2cFortran
174 #endif
175 
176 /* VAX/VMS does not let us \-split long #if lines. */
177 /* Split #if into 2 because some HP-UX can't handle long #if */
178 #if !(defined(NAGf90Fortran)||defined(f2cFortran)||defined(hpuxFortran)||defined(apolloFortran)||defined(sunFortran)||defined(IBMR2Fortran)||defined(CRAYFortran))
179 #if !(defined(mipsFortran)||defined(DECFortran)||defined(vmsFortran)||defined(CONVEXFortran)||defined(PowerStationFortran)||defined(AbsoftUNIXFortran)||defined(AbsoftProFortran)||defined(SXFortran))
180 /* If no Fortran compiler is given, we choose one for the machines we know. */
181 #if defined(lynx) || defined(VAXUltrix)
182 #define f2cFortran /* Lynx: Only support f2c at the moment.
183  VAXUltrix: f77 behaves like f2c.
184  Support f2c or f77 with gcc, vcc with f2c.
185  f77 with vcc works, missing link magic for f77 I/O.*/
186 #endif
187 /* 04/13/00 DM (CFITSIO): Add these lines for NT */
188 /* with PowerStationFortran and and Visual C++ */
189 #if defined(WIN32) && !defined(__CYGWIN__)
190 #define PowerStationFortran
191 #define VISUAL_CPLUSPLUS
192 #endif
193 #if defined(g77Fortran) /* 11/03/97 PDW (CFITSIO) */
194 #define f2cFortran
195 #endif
196 #if defined(__CYGWIN__) /* 04/11/02 LEB (CFITSIO) */
197 #define f2cFortran
198 #endif
199 #if defined(__GNUC__) && defined(linux) /* 06/21/00 PDW (CFITSIO) */
200 #define f2cFortran
201 #endif
202 #if defined(macintosh) /* 11/1999 (CFITSIO) */
203 #define f2cFortran
204 #endif
205 #if defined(__APPLE__) /* 11/2002 (CFITSIO) */
206 #define f2cFortran
207 #endif
208 #if defined(__hpux) /* 921107: Use __hpux instead of __hp9000s300 */
209 #define hpuxFortran /* Should also allow hp9000s7/800 use.*/
210 #endif
211 #if defined(apollo)
212 #define apolloFortran /* __CF__APOLLO67 also defines some behavior. */
213 #endif
214 #if defined(sun) || defined(__sun)
215 #define sunFortran
216 #endif
217 #if defined(_IBMR2)
218 #define IBMR2Fortran
219 #endif
220 #if defined(_CRAY)
221 #define CRAYFortran /* _CRAYT3E also defines some behavior. */
222 #endif
223 #if defined(_SX)
224 #define SXFortran
225 #endif
226 #if defined(mips) || defined(__mips)
227 #define mipsFortran
228 #endif
229 #if defined(vms) || defined(__vms)
230 #define vmsFortran
231 #endif
232 #if defined(__alpha) && defined(__unix__)
233 #define DECFortran
234 #endif
235 #if defined(__convex__)
236 #define CONVEXFortran
237 #endif
238 #if defined(VISUAL_CPLUSPLUS)
239 #define PowerStationFortran
240 #endif
241 #endif /* ...Fortran */
242 #endif /* ...Fortran */
243 
244 /* Split #if into 2 because some HP-UX can't handle long #if */
245 #if !(defined(NAGf90Fortran)||defined(f2cFortran)||defined(hpuxFortran)||defined(apolloFortran)||defined(sunFortran)||defined(IBMR2Fortran)||defined(CRAYFortran))
246 #if !(defined(mipsFortran)||defined(DECFortran)||defined(vmsFortran)||defined(CONVEXFortran)||defined(PowerStationFortran)||defined(AbsoftUNIXFortran)||defined(AbsoftProFortran)||defined(SXFortran))
247 /* If your compiler barfs on ' #error', replace # with the trigraph for # */
248  #error "cfortran.h: Can't find your environment among:\
249  - GNU gcc (g77) on Linux. \
250  - MIPS cc and f77 2.0. (e.g. Silicon Graphics, DECstations, ...) \
251  - IBM AIX XL C and FORTRAN Compiler/6000 Version 01.01.0000.0000 \
252  - VAX VMS CC 3.1 and FORTRAN 5.4. \
253  - Alpha VMS DEC C 1.3 and DEC FORTRAN 6.0. \
254  - Alpha OSF DEC C and DEC Fortran for OSF/1 AXP Version 1.2 \
255  - Apollo DomainOS 10.2 (sys5.3) with f77 10.7 and cc 6.7. \
256  - CRAY \
257  - NEC SX-4 SUPER-UX \
258  - CONVEX \
259  - Sun \
260  - PowerStation Fortran with Visual C++ \
261  - HP9000s300/s700/s800 Latest test with: HP-UX A.08.07 A 9000/730 \
262  - LynxOS: cc or gcc with f2c. \
263  - VAXUltrix: vcc,cc or gcc with f2c. gcc or cc with f77. \
264  - f77 with vcc works; but missing link magic for f77 I/O. \
265  - NO fort. None of gcc, cc or vcc generate required names.\
266  - f2c/g77: Use #define f2cFortran, or cc -Df2cFortran \
267  - gfortran: Use #define gFortran, or cc -DgFortran \
268  (also necessary for g77 with -fno-f2c option) \
269  - NAG f90: Use #define NAGf90Fortran, or cc -DNAGf90Fortran \
270  - Absoft UNIX F77: Use #define AbsoftUNIXFortran or cc -DAbsoftUNIXFortran \
271  - Absoft Pro Fortran: Use #define AbsoftProFortran \
272  - Portland Group Fortran: Use #define pgiFortran \
273  - Intel Fortran: Use #define INTEL_COMPILER"
274 /* Compiler must throw us out at this point! */
275 #endif
276 #endif
277 
278 
279 #if defined(VAXC) && !defined(__VAXC)
280 #define OLD_VAXC
281 #pragma nostandard /* Prevent %CC-I-PARAMNOTUSED. */
282 #endif
283 
284 /* Throughout cfortran.h we use: UN = Uppercase Name. LN = Lowercase Name. */
285 
286 /* "extname" changed to "appendus" below (CFITSIO) */
287 #if defined(f2cFortran) || defined(NAGf90Fortran) || defined(DECFortran) || defined(mipsFortran) || defined(apolloFortran) || defined(sunFortran) || defined(CONVEXFortran) || defined(SXFortran) || defined(appendus)
288 #define CFC_(UN,LN) _(LN,_) /* Lowercase FORTRAN symbols. */
289 #define orig_fcallsc(UN,LN) CFC_(UN,LN)
290 #else
291 #if defined(CRAYFortran) || defined(PowerStationFortran) || defined(AbsoftProFortran)
292 #ifdef _CRAY /* (UN), not UN, circumvents CRAY preprocessor bug. */
293 #define CFC_(UN,LN) (UN) /* Uppercase FORTRAN symbols. */
294 #else /* At least VISUAL_CPLUSPLUS barfs on (UN), so need UN. */
295 #define CFC_(UN,LN) UN /* Uppercase FORTRAN symbols. */
296 #endif
297 #define orig_fcallsc(UN,LN) CFC_(UN,LN) /* CRAY insists on arg.'s here. */
298 #else /* For following machines one may wish to change the fcallsc default. */
299 #define CF_SAME_NAMESPACE
300 #ifdef vmsFortran
301 #define CFC_(UN,LN) LN /* Either case FORTRAN symbols. */
302  /* BUT we usually use UN for C macro to FORTRAN routines, so use LN here,*/
303  /* because VAX/VMS doesn't do recursive macros. */
304 #define orig_fcallsc(UN,LN) UN
305 #else /* HP-UX without +ppu or IBMR2 without -qextname. NOT reccomended. */
306 #define CFC_(UN,LN) LN /* Lowercase FORTRAN symbols. */
307 #define orig_fcallsc(UN,LN) CFC_(UN,LN)
308 #endif /* vmsFortran */
309 #endif /* CRAYFortran PowerStationFortran */
310 #endif /* ....Fortran */
311 
312 #define fcallsc(UN,LN) orig_fcallsc(UN,LN)
313 #define preface_fcallsc(P,p,UN,LN) CFC_(_(P,UN),_(p,LN))
314 #define append_fcallsc(P,p,UN,LN) CFC_(_(UN,P),_(LN,p))
315 
316 #define C_FUNCTION(UN,LN) fcallsc(UN,LN)
317 #define FORTRAN_FUNCTION(UN,LN) CFC_(UN,LN)
318 
319 #ifndef COMMON_BLOCK
320 #ifndef CONVEXFortran
321 #ifndef CLIPPERFortran
322 #if !(defined(AbsoftUNIXFortran)||defined(AbsoftProFortran))
323 #define COMMON_BLOCK(UN,LN) CFC_(UN,LN)
324 #else
325 #define COMMON_BLOCK(UN,LN) _(_C,LN)
326 #endif /* AbsoftUNIXFortran or AbsoftProFortran */
327 #else
328 #define COMMON_BLOCK(UN,LN) _(LN,__)
329 #endif /* CLIPPERFortran */
330 #else
331 #define COMMON_BLOCK(UN,LN) _3(_,LN,_)
332 #endif /* CONVEXFortran */
333 #endif /* COMMON_BLOCK */
334 
335 #ifndef OOMPH_DOUBLE_PRECISION
336 #if defined(CRAYFortran) && !defined(_CRAYT3E)
337 #define OOMPH_DOUBLE_PRECISION long double
338 #else
339 #define OOMPH_DOUBLE_PRECISION double
340 #endif
341 #endif
342 
343 #ifndef FORTRAN_REAL
344 #if defined(CRAYFortran) && defined(_CRAYT3E)
345 #define FORTRAN_REAL double
346 #else
347 #define FORTRAN_REAL float
348 #endif
349 #endif
350 
351 #ifdef CRAYFortran
352 #ifdef _CRAY
353 #include <fortran.h>
354 #else
355 #include "fortran.h" /* i.e. if crosscompiling assume user has file. */
356 #endif
357 #define FLOATVVVVVVV_cfPP (FORTRAN_REAL *) /* Used for C calls FORTRAN. */
358 /* CRAY's double==float but CRAY says pointers to doubles and floats are diff.*/
359 #define VOIDP (void *) /* When FORTRAN calls C, we don't know if C routine
360  arg.'s have been declared float *, or double *. */
361 #else
362 #define FLOATVVVVVVV_cfPP
363 #define VOIDP
364 #endif
365 
366 #ifdef vmsFortran
367 #if defined(vms) || defined(__vms)
368 #include <descrip.h>
369 #else
370 #include "descrip.h" /* i.e. if crosscompiling assume user has file. */
371 #endif
372 #endif
373 
374 #ifdef sunFortran
375 #if defined(sun) || defined(__sun)
376 #include <math.h> /* Sun's FLOATFUNCTIONTYPE, ASSIGNFLOAT, RETURNFLOAT. */
377 #else
378 #include "math.h" /* i.e. if crosscompiling assume user has file. */
379 #endif
380 /* At least starting with the default C compiler SC3.0.1 of SunOS 5.3,
381  * FLOATFUNCTIONTYPE, ASSIGNFLOAT, RETURNFLOAT are not required and not in
382  * <math.h>, since sun C no longer promotes C float return values to doubles.
383  * Therefore, only use them if defined.
384  * Even if gcc is being used, assume that it exhibits the Sun C compiler
385  * behavior in order to be able to use *.o from the Sun C compiler.
386  * i.e. If FLOATFUNCTIONTYPE, etc. are in math.h, they required by gcc.
387  */
388 #endif
389 
390 #ifndef apolloFortran
391 /* "extern" removed (CFITSIO) */
392 #define COMMON_BLOCK_DEF(DEFINITION, NAME) /* extern */ DEFINITION NAME
393 #define CF_NULL_PROTO
394 #else /* HP doesn't understand #elif. */
395 /* Without ANSI prototyping, Apollo promotes float functions to double. */
396 /* Note that VAX/VMS, IBM, Mips choke on 'type function(...);' prototypes. */
397 #define CF_NULL_PROTO ...
398 #ifndef __CF__APOLLO67
399 #define COMMON_BLOCK_DEF(DEFINITION, NAME) \
400  DEFINITION NAME __attribute((__section(NAME)))
401 #else
402 #define COMMON_BLOCK_DEF(DEFINITION, NAME) \
403  DEFINITION NAME #attribute[section(NAME)]
404 #endif
405 #endif
406 
407 #ifdef __cplusplus
408 #undef CF_NULL_PROTO
409 #define CF_NULL_PROTO ...
410 #endif
411 
412 
413 #ifndef USE_NEW_DELETE
414 #ifdef __cplusplus
415 #define USE_NEW_DELETE 1
416 #else
417 #define USE_NEW_DELETE 0
418 #endif
419 #endif
420 #if USE_NEW_DELETE
421 #define _cf_malloc(N) new char[N]
422 #define _cf_free(P) delete[] P
423 #else
424 #define _cf_malloc(N) (char *)malloc(N)
425 #define _cf_free(P) free(P)
426 #endif
427 
428 #ifdef mipsFortran
429 #define CF_DECLARE_GETARG int f77argc; char **f77argv
430 #define CF_SET_GETARG(ARGC,ARGV) f77argc = ARGC; f77argv = ARGV
431 #else
432 #define CF_DECLARE_GETARG
433 #define CF_SET_GETARG(ARGC,ARGV)
434 #endif
435 
436 #ifdef OLD_VAXC /* Allow %CC-I-PARAMNOTUSED. */
437 #pragma standard
438 #endif
439 
440 #define AcfCOMMA ,
441 #define AcfCOLON ;
442 
443 /*-------------------------------------------------------------------------*/
444 
445 /* UTILITIES USED WITHIN CFORTRAN.H */
446 
447 #define _cfMIN(A,B) (A<B?A:B)
448 
449 /* 970211 - XIX.145:
450  firstindexlength - better name is all_but_last_index_lengths
451  secondindexlength - better name is last_index_length
452  */
453 #define firstindexlength(A) (sizeof(A[0])==1 ? 1 : (sizeof(A) / sizeof(A[0])) )
454 #define secondindexlength(A) (sizeof(A[0])==1 ? sizeof(A) : sizeof(A[0]) )
455 
456 /* Behavior of FORTRAN LOGICAL. All machines' LOGICAL is same size as C's int.
457 Conversion is automatic except for arrays which require F2CLOGICALV/C2FLOGICALV.
458 f2c, MIPS f77 [DECstation, SGI], VAX Ultrix f77,
459 HP-UX f77 : as in C.
460 VAX/VMS FORTRAN, VAX Ultrix fort,
461 Absoft Unix Fortran, IBM RS/6000 xlf : LS Bit = 0/1 = TRUE/FALSE.
462 Apollo : neg. = TRUE, else FALSE.
463 [Apollo accepts -1 as TRUE for function values, but NOT all other neg. values.]
464 [DECFortran for Ultrix RISC is also called f77 but is the same as VAX/VMS.]
465 [MIPS f77 treats .eqv./.neqv. as .eq./.ne. and hence requires LOGICAL_STRICT.]*/
466 
467 #if defined(NAGf90Fortran) || defined(f2cFortran) || defined(mipsFortran) || defined(PowerStationFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran) || defined(AbsoftProFortran) || defined(SXFortran)
468 /* SX/PowerStationFortran have 0 and 1 defined, others are neither T nor F. */
469 /* hpuxFortran800 has 0 and 0x01000000 defined. Others are unknown. */
470 #define LOGICAL_STRICT /* Other Fortran have .eqv./.neqv. == .eq./.ne. */
471 #endif
472 
473 #define C2FLOGICALV(A,I) \
474  do {int __i; for(__i=0;__i<I;__i++) A[__i]=C2FLOGICAL(A[__i]); } while (0)
475 #define F2CLOGICALV(A,I) \
476  do {int __i; for(__i=0;__i<I;__i++) A[__i]=F2CLOGICAL(A[__i]); } while (0)
477 
478 #if defined(apolloFortran)
479 #define C2FLOGICAL(L) ((L)?-1:(L)&~((unsigned)1<<sizeof(int)*8-1))
480 #define F2CLOGICAL(L) ((L)<0?(L):0)
481 #else
482 #if defined(CRAYFortran)
483 #define C2FLOGICAL(L) _btol(L)
484 #define F2CLOGICAL(L) _ltob(&(L)) /* Strangely _ltob() expects a pointer. */
485 #else
486 #if defined(IBMR2Fortran) || defined(vmsFortran) || defined(DECFortran) || defined(AbsoftUNIXFortran)
487 /* How come no AbsoftProFortran ? */
488 #define C2FLOGICAL(L) ((L)?(L)|1:(L)&~(int)1)
489 #define F2CLOGICAL(L) ((L)&1?(L):0)
490 #else
491 #if defined(CONVEXFortran)
492 #define C2FLOGICAL(L) ((L) ? ~0 : 0 )
493 #define F2CLOGICAL(L) (L)
494 #else /* others evaluate LOGICALs as for C. */
495 #define C2FLOGICAL(L) (L)
496 #define F2CLOGICAL(L) (L)
497 #ifndef LOGICAL_STRICT
498 #undef C2FLOGICALV
499 #undef F2CLOGICALV
500 #define C2FLOGICALV(A,I)
501 #define F2CLOGICALV(A,I)
502 #endif /* LOGICAL_STRICT */
503 #endif /* CONVEXFortran || All Others */
504 #endif /* IBMR2Fortran vmsFortran DECFortran AbsoftUNIXFortran */
505 #endif /* CRAYFortran */
506 #endif /* apolloFortran */
507 
508 /* 970514 - In addition to CRAY, there may be other machines
509  for which LOGICAL_STRICT makes no sense. */
510 #if defined(LOGICAL_STRICT) && !defined(CRAYFortran)
511 /* Force C2FLOGICAL to generate only the values for either .TRUE. or .FALSE.
512  SX/PowerStationFortran only have 0 and 1 defined.
513  Elsewhere, only needed if you want to do:
514  logical lvariable
515  if (lvariable .eq. .true.) then ! (1)
516  instead of
517  if (lvariable .eqv. .true.) then ! (2)
518  - (1) may not even be FORTRAN/77 and that Apollo's f77 and IBM's xlf
519  refuse to compile (1), so you are probably well advised to stay away from
520  (1) and from LOGICAL_STRICT.
521  - You pay a (slight) performance penalty for using LOGICAL_STRICT. */
522 #undef C2FLOGICAL
523 #ifdef hpuxFortran800
524 #define C2FLOGICAL(L) ((L)?0x01000000:0)
525 #else
526 #if defined(apolloFortran) || defined(vmsFortran) || defined(DECFortran)
527 #define C2FLOGICAL(L) ((L)?-1:0) /* These machines use -1/0 for .true./.false.*/
528 #else
529 #define C2FLOGICAL(L) ((L)? 1:0) /* All others use +1/0 for .true./.false.*/
530 #endif
531 #endif
532 #endif /* LOGICAL_STRICT */
533 
534 /* Convert a vector of C strings into FORTRAN strings. */
535 #ifndef __CF__KnR
536 static char *c2fstrv(char* cstr, char *fstr, int elem_len, int sizeofcstr)
537 #else
538 static char *c2fstrv( cstr, fstr, elem_len, sizeofcstr)
539  char* cstr; char *fstr; int elem_len; int sizeofcstr;
540 #endif
541 { int i,j;
542 /* elem_len includes \0 for C strings. Fortran strings don't have term. \0.
543  Useful size of string must be the same in both languages. */
544 for (i=0; i<sizeofcstr/elem_len; i++) {
545  for (j=1; j<elem_len && *cstr; j++) *fstr++ = *cstr++;
546  cstr += 1+elem_len-j;
547  for (; j<elem_len; j++) *fstr++ = ' ';
548 } /* 95109 - Seems to be returning the original fstr. */
549 return fstr-sizeofcstr+sizeofcstr/elem_len; }
550 
551 /* Convert a vector of FORTRAN strings into C strings. */
552 #ifndef __CF__KnR
553 static char *f2cstrv(char *fstr, char* cstr, int elem_len, int sizeofcstr)
554 #else
555 static char *f2cstrv( fstr, cstr, elem_len, sizeofcstr)
556  char *fstr; char* cstr; int elem_len; int sizeofcstr;
557 #endif
558 { int i,j;
559 /* elem_len includes \0 for C strings. Fortran strings don't have term. \0.
560  Useful size of string must be the same in both languages. */
561 cstr += sizeofcstr;
562 fstr += sizeofcstr - sizeofcstr/elem_len;
563 for (i=0; i<sizeofcstr/elem_len; i++) {
564  *--cstr = '\0';
565  for (j=1; j<elem_len; j++) *--cstr = *--fstr;
566 } return cstr; }
567 
568 /* kill the trailing char t's in string s. */
569 #ifndef __CF__KnR
570 static char *kill_trailing(char *s, char t)
571 #else
572 static char *kill_trailing( s, t) char *s; char t;
573 #endif
574 {char *e;
575 e = s + strlen(s);
576 if (e>s) { /* Need this to handle NULL string.*/
577  while (e>s && *--e==t); /* Don't follow t's past beginning. */
578  e[*e==t?0:1] = '\0'; /* Handle s[0]=t correctly. */
579 } return s; }
580 
581 /* kill_trailingn(s,t,e) will kill the trailing t's in string s. e normally
582 points to the terminating '\0' of s, but may actually point to anywhere in s.
583 s's new '\0' will be placed at e or earlier in order to remove any trailing t's.
584 If e<s string s is left unchanged. */
585 #ifndef __CF__KnR
586 static char *kill_trailingn(char *s, char t, char *e)
587 #else
588 static char *kill_trailingn( s, t, e) char *s; char t; char *e;
589 #endif
590 {
591 if (e==s) *e = '\0'; /* Kill the string makes sense here.*/
592 else if (e>s) { /* Watch out for neg. length string.*/
593  while (e>s && *--e==t); /* Don't follow t's past beginning. */
594  e[*e==t?0:1] = '\0'; /* Handle s[0]=t correctly. */
595 } return s; }
596 
597 /* Note the following assumes that any element which has t's to be chopped off,
598 does indeed fill the entire element. */
599 #ifndef __CF__KnR
600 static char *vkill_trailing(char* cstr, int elem_len, int sizeofcstr, char t)
601 #else
602 static char *vkill_trailing( cstr, elem_len, sizeofcstr, t)
603  char* cstr; int elem_len; int sizeofcstr; char t;
604 #endif
605 { int i;
606 for (i=0; i<sizeofcstr/elem_len; i++) /* elem_len includes \0 for C strings. */
607  kill_trailingn(cstr+elem_len*i,t,cstr+elem_len*(i+1)-1);
608 return cstr; }
609 
610 #ifdef vmsFortran
611 typedef struct dsc$descriptor_s fstring;
612 #define DSC$DESCRIPTOR_A(DIMCT) \
613 struct { \
614  unsigned short dsc$w_length; unsigned char dsc$b_dtype; \
615  unsigned char dsc$b_class; char *dsc$a_pointer; \
616  char dsc$b_scale; unsigned char dsc$b_digits; \
617  struct { \
618  unsigned : 3; unsigned dsc$v_fl_binscale : 1; \
619  unsigned dsc$v_fl_redim : 1; unsigned dsc$v_fl_column : 1; \
620  unsigned dsc$v_fl_coeff : 1; unsigned dsc$v_fl_bounds : 1; \
621  } dsc$b_aflags; \
622  unsigned char dsc$b_dimct; unsigned long dsc$l_arsize; \
623  char *dsc$a_a0; long dsc$l_m [DIMCT]; \
624  struct { \
625  long dsc$l_l; long dsc$l_u; \
626  } dsc$bounds [DIMCT]; \
627 }
628 typedef DSC$DESCRIPTOR_A(1) fstringvector;
629 /*typedef DSC$DESCRIPTOR_A(2) fstringarrarr;
630  typedef DSC$DESCRIPTOR_A(3) fstringarrarrarr;*/
631 #define initfstr(F,C,ELEMNO,ELEMLEN) \
632 ( (F).dsc$l_arsize= ( (F).dsc$w_length =(ELEMLEN) ) \
633  *( (F).dsc$l_m[0]=(F).dsc$bounds[0].dsc$l_u=(ELEMNO) ), \
634  (F).dsc$a_a0 = ( (F).dsc$a_pointer=(C) ) - (F).dsc$w_length ,(F))
635 
636 #endif /* PDW: 2/10/98 (CFITSIO) -- Let VMS see NUM_ELEMS definitions */
637 #define _NUM_ELEMS -1
638 #define _NUM_ELEM_ARG -2
639 #define NUM_ELEMS(A) A,_NUM_ELEMS
640 #define NUM_ELEM_ARG(B) *_2(A,B),_NUM_ELEM_ARG
641 #define TERM_CHARS(A,B) A,B
642 #ifndef __CF__KnR
643 static int num_elem(char *strv, unsigned elem_len, int term_char, int num_term)
644 #else
645 static int num_elem( strv, elem_len, term_char, num_term)
646  char *strv; unsigned elem_len; int term_char; int num_term;
647 #endif
648 /* elem_len is the number of characters in each element of strv, the FORTRAN
649 vector of strings. The last element of the vector must begin with at least
650 num_term term_char characters, so that this routine can determine how
651 many elements are in the vector. */
652 {
653 unsigned num,i;
654 if (num_term == _NUM_ELEMS || num_term == _NUM_ELEM_ARG)
655  return term_char;
656 if (num_term <=0) num_term = (int)elem_len;
657 for (num=0; ; num++) {
658  for (i=0; i<(unsigned)num_term && *strv==term_char; i++,strv++);
659  if (i==(unsigned)num_term) break;
660  else strv += elem_len-i;
661 }
662 if (0) { /* to prevent not used warnings in gcc (added by ROOT) */
663  c2fstrv(0, 0, 0, 0); f2cstrv(0, 0, 0, 0); kill_trailing(0, 0);
664  vkill_trailing(0, 0, 0, 0); num_elem(0, 0, 0, 0);
665 }
666 return (int)num;
667 }
668 /* #endif removed 2/10/98 (CFITSIO) */
669 
670 /*-------------------------------------------------------------------------*/
671 
672 /* UTILITIES FOR C TO USE STRINGS IN FORTRAN COMMON BLOCKS */
673 
674 /* C string TO Fortran Common Block STRing. */
675 /* DIM is the number of DIMensions of the array in terms of strings, not
676  characters. e.g. char a[12] has DIM = 0, char a[12][4] has DIM = 1, etc. */
677 #define C2FCBSTR(CSTR,FSTR,DIM) \
678  c2fstrv((char *)CSTR, (char *)FSTR, sizeof(FSTR)/cfelementsof(FSTR,DIM)+1, \
679  sizeof(FSTR)+cfelementsof(FSTR,DIM))
680 
681 /* Fortran Common Block string TO C STRing. */
682 #define FCB2CSTR(FSTR,CSTR,DIM) \
683  vkill_trailing(f2cstrv((char *)FSTR, (char *)CSTR, \
684  sizeof(FSTR)/cfelementsof(FSTR,DIM)+1, \
685  sizeof(FSTR)+cfelementsof(FSTR,DIM)), \
686  sizeof(FSTR)/cfelementsof(FSTR,DIM)+1, \
687  sizeof(FSTR)+cfelementsof(FSTR,DIM), ' ')
688 
689 #define cfDEREFERENCE0
690 #define cfDEREFERENCE1 *
691 #define cfDEREFERENCE2 **
692 #define cfDEREFERENCE3 ***
693 #define cfDEREFERENCE4 ****
694 #define cfDEREFERENCE5 *****
695 #define cfelementsof(A,D) (sizeof(A)/sizeof(_(cfDEREFERENCE,D)(A)))
696 
697 /*-------------------------------------------------------------------------*/
698 
699 /* UTILITIES FOR C TO CALL FORTRAN SUBROUTINES */
700 
701 /* Define lookup tables for how to handle the various types of variables. */
702 
703 #ifdef OLD_VAXC /* Prevent %CC-I-PARAMNOTUSED. */
704 #pragma nostandard
705 #endif
706 
707 #define ZTRINGV_NUM(I) I
708 #define ZTRINGV_ARGFP(I) (*(_2(A,I))) /* Undocumented. For PINT, etc. */
709 #define ZTRINGV_ARGF(I) _2(A,I)
710 #ifdef CFSUBASFUN
711 #define ZTRINGV_ARGS(I) ZTRINGV_ARGF(I)
712 #else
713 #define ZTRINGV_ARGS(I) _2(B,I)
714 #endif
715 
716 #define PBYTE_cfVP(A,B) PINT_cfVP(A,B)
717 #define PDOUBLE_cfVP(A,B)
718 #define PFLOAT_cfVP(A,B)
719 #ifdef ZTRINGV_ARGS_allows_Pvariables
720 /* This allows Pvariables for ARGS. ARGF machinery is above ARGFP.
721  * B is not needed because the variable may be changed by the Fortran routine,
722  * but because B is the only way to access an arbitrary macro argument. */
723 #define PINT_cfVP(A,B) int B = (int)A; /* For ZSTRINGV_ARGS */
724 #else
725 #define PINT_cfVP(A,B)
726 #endif
727 #define PLOGICAL_cfVP(A,B) int *B; /* Returning LOGICAL in FUNn and SUBn */
728 #define PLONG_cfVP(A,B) PINT_cfVP(A,B)
729 #define PSHORT_cfVP(A,B) PINT_cfVP(A,B)
730 
731 #define VCF_INT_S(T,A,B) _(T,VVVVVVV_cfTYPE) B = A;
732 #define VCF_INT_F(T,A,B) _(T,_cfVCF)(A,B)
733 /* _cfVCF table is directly mapped to _cfCCC table. */
734 #define BYTE_cfVCF(A,B)
735 #define DOUBLE_cfVCF(A,B)
736 #if !defined(__CF__KnR)
737 #define FLOAT_cfVCF(A,B)
738 #else
739 #define FLOAT_cfVCF(A,B) FORTRAN_REAL B = A;
740 #endif
741 #define INT_cfVCF(A,B)
742 #define LOGICAL_cfVCF(A,B)
743 #define LONG_cfVCF(A,B)
744 #define SHORT_cfVCF(A,B)
745 
746 /* 980416
747  Cast (void (*)(CF_NULL_PROTO)) causes SunOS CC 4.2 occasionally to barf,
748  while the following equivalent typedef is fine.
749  For consistency use the typedef on all machines.
750  */
751 typedef void (*cfCAST_FUNCTION)(CF_NULL_PROTO);
752 
753 #define VCF(TN,I) _Icf4(4,V,TN,_(A,I),_(B,I),F)
754 #define VVCF(TN,AI,BI) _Icf4(4,V,TN,AI,BI,S)
755 #define INT_cfV(T,A,B,F) _(VCF_INT_,F)(T,A,B)
756 #define INTV_cfV(T,A,B,F)
757 #define INTVV_cfV(T,A,B,F)
758 #define INTVVV_cfV(T,A,B,F)
759 #define INTVVVV_cfV(T,A,B,F)
760 #define INTVVVVV_cfV(T,A,B,F)
761 #define INTVVVVVV_cfV(T,A,B,F)
762 #define INTVVVVVVV_cfV(T,A,B,F)
763 #define PINT_cfV( T,A,B,F) _(T,_cfVP)(A,B)
764 #define PVOID_cfV( T,A,B,F)
765 #if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran) || defined(AbsoftProFortran)
766 #define ROUTINE_cfV(T,A,B,F) void (*B)(CF_NULL_PROTO) = (cfCAST_FUNCTION)A;
767 #else
768 #define ROUTINE_cfV(T,A,B,F)
769 #endif
770 #define SIMPLE_cfV(T,A,B,F)
771 #ifdef vmsFortran
772 #define STRING_cfV(T,A,B,F) static struct {fstring f; unsigned clen;} B = \
773  {{0,DSC$K_DTYPE_T,DSC$K_CLASS_S,NULL},0};
774 #define PSTRING_cfV(T,A,B,F) static fstring B={0,DSC$K_DTYPE_T,DSC$K_CLASS_S,NULL};
775 #define STRINGV_cfV(T,A,B,F) static fstringvector B = \
776  {sizeof(A),DSC$K_DTYPE_T,DSC$K_CLASS_A,NULL,0,0,{0,0,1,1,1},1,0,NULL,0,{1,0}};
777 #define PSTRINGV_cfV(T,A,B,F) static fstringvector B = \
778  {0,DSC$K_DTYPE_T,DSC$K_CLASS_A,NULL,0,0,{0,0,1,1,1},1,0,NULL,0,{1,0}};
779 #else
780 #define STRING_cfV(T,A,B,F) struct {unsigned int clen, flen; char *nombre;} B;
781 #define STRINGV_cfV(T,A,B,F) struct {char *s, *fs; unsigned flen; char *nombre;} B;
782 #define PSTRING_cfV(T,A,B,F) int B;
783 #define PSTRINGV_cfV(T,A,B,F) struct{char *fs; unsigned int sizeofA,flen;}B;
784 #endif
785 #define ZTRINGV_cfV(T,A,B,F) STRINGV_cfV(T,A,B,F)
786 #define PZTRINGV_cfV(T,A,B,F) PSTRINGV_cfV(T,A,B,F)
787 
788 /* Note that the actions of the A table were performed inside the AA table.
789  VAX Ultrix vcc, and HP-UX cc, didn't evaluate arguments to functions left to
790  right, so we had to split the original table into the current robust two. */
791 #define ACF(NAME,TN,AI,I) _(TN,_cfSTR)(4,A,NAME,I,AI,_(B,I),0)
792 #define DEFAULT_cfA(M,I,A,B)
793 #define LOGICAL_cfA(M,I,A,B) B=C2FLOGICAL(B);
794 #define PLOGICAL_cfA(M,I,A,B) A=C2FLOGICAL(A);
795 #define STRING_cfA(M,I,A,B) STRING_cfC(M,I,A,B,sizeof(A))
796 #define PSTRING_cfA(M,I,A,B) PSTRING_cfC(M,I,A,B,sizeof(A))
797 #ifdef vmsFortran
798 #define AATRINGV_cfA( A,B, sA,filA,silA) \
799  initfstr(B,_cf_malloc((sA)-(filA)),(filA),(silA)-1), \
800  c2fstrv(A,B.dsc$a_pointer,(silA),(sA));
801 #define APATRINGV_cfA( A,B, sA,filA,silA) \
802  initfstr(B,A,(filA),(silA)-1),c2fstrv(A,A,(silA),(sA));
803 #else
804 #define AATRINGV_cfA( A,B, sA,filA,silA) \
805  (B.s=_cf_malloc((sA)-(filA)),B.fs=c2fstrv(A,B.s,(B.flen=(silA)-1)+1,(sA)));
806 #define APATRINGV_cfA( A,B, sA,filA,silA) \
807  B.fs=c2fstrv(A,A,(B.flen=(silA)-1)+1,B.sizeofA=(sA));
808 #endif
809 #define STRINGV_cfA(M,I,A,B) \
810  AATRINGV_cfA((char *)A,B,sizeof(A),firstindexlength(A),secondindexlength(A))
811 #define PSTRINGV_cfA(M,I,A,B) \
812  APATRINGV_cfA((char *)A,B,sizeof(A),firstindexlength(A),secondindexlength(A))
813 #define ZTRINGV_cfA(M,I,A,B) AATRINGV_cfA( (char *)A,B, \
814  (_3(M,_ELEMS_,I))*(( _3(M,_ELEMLEN_,I))+1), \
815  (_3(M,_ELEMS_,I)),(_3(M,_ELEMLEN_,I))+1)
816 #define PZTRINGV_cfA(M,I,A,B) APATRINGV_cfA( (char *)A,B, \
817  (_3(M,_ELEMS_,I))*(( _3(M,_ELEMLEN_,I))+1), \
818  (_3(M,_ELEMS_,I)),(_3(M,_ELEMLEN_,I))+1)
819 
820 #define PBYTE_cfAAP(A,B) &A
821 #define PDOUBLE_cfAAP(A,B) &A
822 #define PFLOAT_cfAAP(A,B) FLOATVVVVVVV_cfPP &A
823 #define PINT_cfAAP(A,B) &A
824 #define PLOGICAL_cfAAP(A,B) B= &A /* B used to keep a common W table. */
825 #define PLONG_cfAAP(A,B) &A
826 #define PSHORT_cfAAP(A,B) &A
827 
828 #define AACF(TN,AI,I,C) _SEP_(TN,C,cfCOMMA) _Icf(3,AA,TN,AI,_(B,I))
829 #define INT_cfAA(T,A,B) &B
830 #define INTV_cfAA(T,A,B) _(T,VVVVVV_cfPP) A
831 #define INTVV_cfAA(T,A,B) _(T,VVVVV_cfPP) A[0]
832 #define INTVVV_cfAA(T,A,B) _(T,VVVV_cfPP) A[0][0]
833 #define INTVVVV_cfAA(T,A,B) _(T,VVV_cfPP) A[0][0][0]
834 #define INTVVVVV_cfAA(T,A,B) _(T,VV_cfPP) A[0][0][0][0]
835 #define INTVVVVVV_cfAA(T,A,B) _(T,V_cfPP) A[0][0][0][0][0]
836 #define INTVVVVVVV_cfAA(T,A,B) _(T,_cfPP) A[0][0][0][0][0][0]
837 #define PINT_cfAA(T,A,B) _(T,_cfAAP)(A,B)
838 #define PVOID_cfAA(T,A,B) (void *) A
839 #if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran)
840 #define ROUTINE_cfAA(T,A,B) &B
841 #else
842 #define ROUTINE_cfAA(T,A,B) (cfCAST_FUNCTION)A
843 #endif
844 #define STRING_cfAA(T,A,B) STRING_cfCC(T,A,B)
845 #define PSTRING_cfAA(T,A,B) PSTRING_cfCC(T,A,B)
846 #ifdef vmsFortran
847 #define STRINGV_cfAA(T,A,B) &B
848 #else
849 #ifdef CRAYFortran
850 #define STRINGV_cfAA(T,A,B) _cptofcd(B.fs,B.flen)
851 #else
852 #define STRINGV_cfAA(T,A,B) B.fs
853 #endif
854 #endif
855 #define PSTRINGV_cfAA(T,A,B) STRINGV_cfAA(T,A,B)
856 #define ZTRINGV_cfAA(T,A,B) STRINGV_cfAA(T,A,B)
857 #define PZTRINGV_cfAA(T,A,B) STRINGV_cfAA(T,A,B)
858 
859 #if defined(vmsFortran) || defined(CRAYFortran)
860 #define JCF(TN,I)
861 #define KCF(TN,I)
862 #else
863 #define JCF(TN,I) _(TN,_cfSTR)(1,J,_(B,I), 0,0,0,0)
864 #if defined(AbsoftUNIXFortran)
865 #define DEFAULT_cfJ(B) ,0
866 #else
867 #define DEFAULT_cfJ(B)
868 #endif
869 #define LOGICAL_cfJ(B) DEFAULT_cfJ(B)
870 #define PLOGICAL_cfJ(B) DEFAULT_cfJ(B)
871 #define STRING_cfJ(B) ,B.flen
872 #define PSTRING_cfJ(B) ,B
873 #define STRINGV_cfJ(B) STRING_cfJ(B)
874 #define PSTRINGV_cfJ(B) STRING_cfJ(B)
875 #define ZTRINGV_cfJ(B) STRING_cfJ(B)
876 #define PZTRINGV_cfJ(B) STRING_cfJ(B)
877 
878 /* KCF is identical to DCF, except that KCF ZTRING is not empty. */
879 #define KCF(TN,I) _(TN,_cfSTR)(1,KK,_(B,I), 0,0,0,0)
880 #if defined(AbsoftUNIXFortran)
881 #define DEFAULT_cfKK(B) , unsigned B
882 #else
883 #define DEFAULT_cfKK(B)
884 #endif
885 #define LOGICAL_cfKK(B) DEFAULT_cfKK(B)
886 #define PLOGICAL_cfKK(B) DEFAULT_cfKK(B)
887 #define STRING_cfKK(B) , unsigned B
888 #define PSTRING_cfKK(B) STRING_cfKK(B)
889 #define STRINGV_cfKK(B) STRING_cfKK(B)
890 #define PSTRINGV_cfKK(B) STRING_cfKK(B)
891 #define ZTRINGV_cfKK(B) STRING_cfKK(B)
892 #define PZTRINGV_cfKK(B) STRING_cfKK(B)
893 #endif
894 
895 #define WCF(TN,AN,I) _(TN,_cfSTR)(2,W,AN,_(B,I), 0,0,0)
896 #define DEFAULT_cfW(A,B)
897 #define LOGICAL_cfW(A,B)
898 #define PLOGICAL_cfW(A,B) *B=F2CLOGICAL(*B);
899 #define STRING_cfW(A,B) (B.nombre=A,B.nombre[B.clen]!='\0'?B.nombre[B.clen]='\0':0); /* A?="constnt"*/
900 #define PSTRING_cfW(A,B) kill_trailing(A,' ');
901 #ifdef vmsFortran
902 #define STRINGV_cfW(A,B) _cf_free(B.dsc$a_pointer);
903 #define PSTRINGV_cfW(A,B) \
904  vkill_trailing(f2cstrv((char*)A, (char*)A, \
905  B.dsc$w_length+1, B.dsc$l_arsize+B.dsc$l_m[0]), \
906  B.dsc$w_length+1, B.dsc$l_arsize+B.dsc$l_m[0], ' ');
907 #else
908 #define STRINGV_cfW(A,B) _cf_free(B.s);
909 #define PSTRINGV_cfW(A,B) vkill_trailing( \
910  f2cstrv((char*)A,(char*)A,B.flen+1,B.sizeofA), B.flen+1,B.sizeofA,' ');
911 #endif
912 #define ZTRINGV_cfW(A,B) STRINGV_cfW(A,B)
913 #define PZTRINGV_cfW(A,B) PSTRINGV_cfW(A,B)
914 
915 #define NCF(TN,I,C) _SEP_(TN,C,cfCOMMA) _Icf(2,N,TN,_(A,I),0)
916 #define NNCF(TN,I,C) UUCF(TN,I,C)
917 #define NNNCF(TN,I,C) _SEP_(TN,C,cfCOLON) _Icf(2,N,TN,_(A,I),0)
918 #define INT_cfN(T,A) _(T,VVVVVVV_cfTYPE) * A
919 #define INTV_cfN(T,A) _(T,VVVVVV_cfTYPE) * A
920 #define INTVV_cfN(T,A) _(T,VVVVV_cfTYPE) * A
921 #define INTVVV_cfN(T,A) _(T,VVVV_cfTYPE) * A
922 #define INTVVVV_cfN(T,A) _(T,VVV_cfTYPE) * A
923 #define INTVVVVV_cfN(T,A) _(T,VV_cfTYPE) * A
924 #define INTVVVVVV_cfN(T,A) _(T,V_cfTYPE) * A
925 #define INTVVVVVVV_cfN(T,A) _(T,_cfTYPE) * A
926 #define PINT_cfN(T,A) _(T,_cfTYPE) * A
927 #define PVOID_cfN(T,A) void * A
928 #if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran)
929 #define ROUTINE_cfN(T,A) void (**A)(CF_NULL_PROTO)
930 #else
931 #define ROUTINE_cfN(T,A) void ( *A)(CF_NULL_PROTO)
932 #endif
933 #ifdef vmsFortran
934 #define STRING_cfN(T,A) fstring * A
935 #define STRINGV_cfN(T,A) fstringvector * A
936 #else
937 #ifdef CRAYFortran
938 #define STRING_cfN(T,A) _fcd A
939 #define STRINGV_cfN(T,A) _fcd A
940 #else
941 #define STRING_cfN(T,A) char * A
942 #define STRINGV_cfN(T,A) char * A
943 #endif
944 #endif
945 #define PSTRING_cfN(T,A) STRING_cfN(T,A) /* CRAY insists on arg.'s here. */
946 #define PNSTRING_cfN(T,A) STRING_cfN(T,A) /* CRAY insists on arg.'s here. */
947 #define PPSTRING_cfN(T,A) STRING_cfN(T,A) /* CRAY insists on arg.'s here. */
948 #define PSTRINGV_cfN(T,A) STRINGV_cfN(T,A)
949 #define ZTRINGV_cfN(T,A) STRINGV_cfN(T,A)
950 #define PZTRINGV_cfN(T,A) PSTRINGV_cfN(T,A)
951 
952 
953 /* Apollo 6.7, CRAY, old Sun, VAX/Ultrix vcc/cc and new ultrix
954  can't hack more than 31 arg's.
955  e.g. ultrix >= 4.3 gives message:
956  zow35> cc -c -DDECFortran cfortest.c
957  cfe: Fatal: Out of memory: cfortest.c
958  zow35>
959  Old __hpux had the problem, but new 'HP-UX A.09.03 A 9000/735' is fine
960  if using -Aa, otherwise we have a problem.
961  */
962 #ifndef MAX_PREPRO_ARGS
963 #if !defined(__GNUC__) && (defined(VAXUltrix) || defined(__CF__APOLLO67) || (defined(sun)&&!defined(__sun)) || defined(_CRAY) || defined(__ultrix__) || (defined(__hpux)&&defined(__CF__KnR)))
964 #define MAX_PREPRO_ARGS 31
965 #else
966 #define MAX_PREPRO_ARGS 99
967 #endif
968 #endif
969 
970 #if defined(AbsoftUNIXFortran) || defined(AbsoftProFortran)
971 /* In addition to explicit Absoft stuff, only Absoft requires:
972  - DEFAULT coming from _cfSTR.
973  DEFAULT could have been called e.g. INT, but keep it for clarity.
974  - M term in CFARGT14 and CFARGT14FS.
975  */
976 #define ABSOFT_cf1(T0) _(T0,_cfSTR)(0,ABSOFT1,0,0,0,0,0)
977 #define ABSOFT_cf2(T0) _(T0,_cfSTR)(0,ABSOFT2,0,0,0,0,0)
978 #define ABSOFT_cf3(T0) _(T0,_cfSTR)(0,ABSOFT3,0,0,0,0,0)
979 #define DEFAULT_cfABSOFT1
980 #define LOGICAL_cfABSOFT1
981 #define STRING_cfABSOFT1 ,MAX_LEN_FORTRAN_FUNCTION_STRING
982 #define DEFAULT_cfABSOFT2
983 #define LOGICAL_cfABSOFT2
984 #define STRING_cfABSOFT2 ,unsigned D0
985 #define DEFAULT_cfABSOFT3
986 #define LOGICAL_cfABSOFT3
987 #define STRING_cfABSOFT3 ,D0
988 #else
989 #define ABSOFT_cf1(T0)
990 #define ABSOFT_cf2(T0)
991 #define ABSOFT_cf3(T0)
992 #endif
993 
994 /* _Z introduced to cicumvent IBM and HP silly preprocessor warning.
995  e.g. "Macro CFARGT14 invoked with a null argument."
996  */
997 #define _Z
998 
999 #define CFARGT14S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
1000  S(T1,1) S(T2,2) S(T3,3) S(T4,4) S(T5,5) S(T6,6) S(T7,7) \
1001  S(T8,8) S(T9,9) S(TA,10) S(TB,11) S(TC,12) S(TD,13) S(TE,14)
1002 #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) \
1003  S(T1,1) S(T2,2) S(T3,3) S(T4,4) S(T5,5) S(T6,6) S(T7,7) \
1004  S(T8,8) S(T9,9) S(TA,10) S(TB,11) S(TC,12) S(TD,13) S(TE,14) \
1005  S(TF,15) S(TG,16) S(TH,17) S(TI,18) S(TJ,19) S(TK,20) S(TL,21) \
1006  S(TM,22) S(TN,23) S(TO,24) S(TP,25) S(TQ,26) S(TR,27)
1007 
1008 #define CFARGT14FS(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
1009  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) \
1010  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) \
1011  M CFARGT14S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
1012 #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) \
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) F(TL,21,1) \
1016  F(TM,22,1) F(TN,23,1) F(TO,24,1) F(TP,25,1) F(TQ,26,1) F(TR,27,1) \
1017  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)
1018 
1019 #if !(defined(PowerStationFortran)||defined(hpuxFortran800))
1020 /* Old CFARGT14 -> CFARGT14FS as seen below, for Absoft cross-compile yields:
1021  SunOS> cc -c -Xa -DAbsoftUNIXFortran c.c
1022  "c.c", line 406: warning: argument mismatch
1023  Haven't checked if this is ANSI C or a SunOS bug. SunOS -Xs works ok.
1024  Behavior is most clearly seen in example:
1025  #define A 1 , 2
1026  #define C(X,Y,Z) x=X. y=Y. z=Z.
1027  #define D(X,Y,Z) C(X,Y,Z)
1028  D(x,A,z)
1029  Output from preprocessor is: x = x . y = 1 . z = 2 .
1030  #define CFARGT14(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
1031  CFARGT14FS(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
1032 */
1033 #define CFARGT14(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
1034  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) \
1035  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) \
1036  M CFARGT14S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
1037 #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) \
1038  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) \
1039  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) \
1040  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) \
1041  F(TM,22,1) F(TN,23,1) F(TO,24,1) F(TP,25,1) F(TQ,26,1) F(TR,27,1) \
1042  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)
1043 
1044 #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) \
1045  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) \
1046  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) \
1047  F(TF,15,1) F(TG,16,1) F(TH,17,1) F(TI,18,1) F(TJ,19,1) F(TK,20,1) \
1048  S(T1,1) S(T2,2) S(T3,3) S(T4,4) S(T5,5) S(T6,6) S(T7,7) \
1049  S(T8,8) S(T9,9) S(TA,10) S(TB,11) S(TC,12) S(TD,13) S(TE,14) \
1050  S(TF,15) S(TG,16) S(TH,17) S(TI,18) S(TJ,19) S(TK,20)
1051 #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) \
1052  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) \
1053  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) \
1054  F(TD,AD,13,1) F(TE,AE,14,1) S(T1,1) S(T2,2) S(T3,3) S(T4,4) \
1055  S(T5,5) S(T6,6) S(T7,7) S(T8,8) S(T9,9) S(TA,10) \
1056  S(TB,11) S(TC,12) S(TD,13) S(TE,14)
1057 #if MAX_PREPRO_ARGS>31
1058 #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) \
1059  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) \
1060  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) \
1061  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) \
1062  F(TJ,AJ,19,1) F(TK,AK,20,1) S(T1,1) S(T2,2) S(T3,3) S(T4,4) \
1063  S(T5,5) S(T6,6) S(T7,7) S(T8,8) S(T9,9) S(TA,10) \
1064  S(TB,11) S(TC,12) S(TD,13) S(TE,14) S(TF,15) S(TG,16) \
1065  S(TH,17) S(TI,18) S(TJ,19) S(TK,20)
1066 #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) \
1067  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) \
1068  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) \
1069  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) \
1070  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) \
1071  F(TP,AP,25,1) F(TQ,AQ,26,1) F(TR,AR,27,1) S(T1,1) S(T2,2) S(T3,3) \
1072  S(T4,4) S(T5,5) S(T6,6) S(T7,7) S(T8,8) S(T9,9) \
1073  S(TA,10) S(TB,11) S(TC,12) S(TD,13) S(TE,14) S(TF,15) \
1074  S(TG,16) S(TH,17) S(TI,18) S(TJ,19) S(TK,20) S(TL,21) \
1075  S(TM,22) S(TN,23) S(TO,24) S(TP,25) S(TQ,26) S(TR,27)
1076 #endif
1077 #else
1078 #define CFARGT14(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
1079  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) \
1080  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) \
1081  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) \
1082  F(TD,13,1) S(TD,13) F(TE,14,1) S(TE,14)
1083 #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) \
1084  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) \
1085  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) \
1086  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) \
1087  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) \
1088  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) \
1089  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) \
1090  F(TP,25,1) S(TP,25) F(TQ,26,1) S(TQ,26) F(TR,27,1) S(TR,27)
1091 
1092 #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) \
1093  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) \
1094  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) \
1095  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) \
1096  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) \
1097  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)
1098 #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) \
1099  F(T1,A1,1,0) S(T1,1) F(T2,A2,2,1) S(T2,2) F(T3,A3,3,1) S(T3,3) \
1100  F(T4,A4,4,1) S(T4,4) F(T5,A5,5,1) S(T5,5) F(T6,A6,6,1) S(T6,6) \
1101  F(T7,A7,7,1) S(T7,7) F(T8,A8,8,1) S(T8,8) F(T9,A9,9,1) S(T9,9) \
1102  F(TA,AA,10,1) S(TA,10) F(TB,AB,11,1) S(TB,11) F(TC,AC,12,1) S(TC,12) \
1103  F(TD,AD,13,1) S(TD,13) F(TE,AE,14,1) S(TE,14)
1104 #if MAX_PREPRO_ARGS>31
1105 #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) \
1106  F(T1,A1,1,0) S(T1,1) F(T2,A2,2,1) S(T2,2) F(T3,A3,3,1) S(T3,3) \
1107  F(T4,A4,4,1) S(T4,4) F(T5,A5,5,1) S(T5,5) F(T6,A6,6,1) S(T6,6) \
1108  F(T7,A7,7,1) S(T7,7) F(T8,A8,8,1) S(T8,8) F(T9,A9,9,1) S(T9,9) \
1109  F(TA,AA,10,1) S(TA,10) F(TB,AB,11,1) S(TB,11) F(TC,AC,12,1) S(TC,12) \
1110  F(TD,AD,13,1) S(TD,13) F(TE,AE,14,1) S(TE,14) F(TF,AF,15,1) S(TF,15) \
1111  F(TG,AG,16,1) S(TG,16) F(TH,AH,17,1) S(TH,17) F(TI,AI,18,1) S(TI,18) \
1112  F(TJ,AJ,19,1) S(TJ,19) F(TK,AK,20,1) S(TK,20)
1113 #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) \
1114  F(T1,A1,1,0) S(T1,1) F(T2,A2,2,1) S(T2,2) F(T3,A3,3,1) S(T3,3) \
1115  F(T4,A4,4,1) S(T4,4) F(T5,A5,5,1) S(T5,5) F(T6,A6,6,1) S(T6,6) \
1116  F(T7,A7,7,1) S(T7,7) F(T8,A8,8,1) S(T8,8) F(T9,A9,9,1) S(T9,9) \
1117  F(TA,AA,10,1) S(TA,10) F(TB,AB,11,1) S(TB,11) F(TC,AC,12,1) S(TC,12) \
1118  F(TD,AD,13,1) S(TD,13) F(TE,AE,14,1) S(TE,14) F(TF,AF,15,1) S(TF,15) \
1119  F(TG,AG,16,1) S(TG,16) F(TH,AH,17,1) S(TH,17) F(TI,AI,18,1) S(TI,18) \
1120  F(TJ,AJ,19,1) S(TJ,19) F(TK,AK,20,1) S(TK,20) F(TL,AL,21,1) S(TL,21) \
1121  F(TM,AM,22,1) S(TM,22) F(TN,AN,23,1) S(TN,23) F(TO,AO,24,1) S(TO,24) \
1122  F(TP,AP,25,1) S(TP,25) F(TQ,AQ,26,1) S(TQ,26) F(TR,AR,27,1) S(TR,27)
1123 #endif
1124 #endif
1125 
1126 
1127 #define PROTOCCALLSFSUB1( UN,LN,T1) \
1128  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)
1129 #define PROTOCCALLSFSUB2( UN,LN,T1,T2) \
1130  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)
1131 #define PROTOCCALLSFSUB3( UN,LN,T1,T2,T3) \
1132  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)
1133 #define PROTOCCALLSFSUB4( UN,LN,T1,T2,T3,T4) \
1134  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)
1135 #define PROTOCCALLSFSUB5( UN,LN,T1,T2,T3,T4,T5) \
1136  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)
1137 #define PROTOCCALLSFSUB6( UN,LN,T1,T2,T3,T4,T5,T6) \
1138  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)
1139 #define PROTOCCALLSFSUB7( UN,LN,T1,T2,T3,T4,T5,T6,T7) \
1140  PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
1141 #define PROTOCCALLSFSUB8( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \
1142  PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
1143 #define PROTOCCALLSFSUB9( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \
1144  PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0,CF_0,CF_0,CF_0,CF_0)
1145 #define PROTOCCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \
1146  PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0)
1147 #define PROTOCCALLSFSUB11(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \
1148  PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0)
1149 #define PROTOCCALLSFSUB12(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \
1150  PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0)
1151 #define PROTOCCALLSFSUB13(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \
1152  PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0)
1153 
1154 
1155 #define PROTOCCALLSFSUB15(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF) \
1156  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)
1157 #define PROTOCCALLSFSUB16(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG) \
1158  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)
1159 #define PROTOCCALLSFSUB17(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH) \
1160  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)
1161 #define PROTOCCALLSFSUB18(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI) \
1162  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)
1163 #define PROTOCCALLSFSUB19(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ) \
1164  PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,CF_0)
1165 
1166 #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) \
1167  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)
1168 #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) \
1169  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)
1170 #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) \
1171  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)
1172 #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) \
1173  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)
1174 #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) \
1175  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)
1176 #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) \
1177  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)
1178 
1179 
1180 #ifndef FCALLSC_QUALIFIER
1181 #ifdef VISUAL_CPLUSPLUS
1182 #define FCALLSC_QUALIFIER __stdcall
1183 #else
1184 #define FCALLSC_QUALIFIER
1185 #endif
1186 #endif
1187 
1188 #ifdef __cplusplus
1189 #define CFextern extern "C"
1190 #else
1191 #define CFextern extern
1192 #endif
1193 
1194 
1195 #ifdef CFSUBASFUN
1196 #define PROTOCCALLSFSUB0(UN,LN) \
1197  PROTOCCALLSFFUN0( VOID,UN,LN)
1198 #define PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
1199  PROTOCCALLSFFUN14(VOID,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
1200 #define PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)\
1201  PROTOCCALLSFFUN20(VOID,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)
1202 #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)\
1203  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)
1204 #else
1205 /* Note: Prevent compiler warnings, null #define PROTOCCALLSFSUB14/20 after
1206  #include-ing cfortran.h if calling the FORTRAN wrapper within the same
1207  source code where the wrapper is created. */
1208 #define PROTOCCALLSFSUB0(UN,LN) _(VOID,_cfPU)(CFC_(UN,LN))();
1209 #ifndef __CF__KnR
1210 #define PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
1211  _(VOID,_cfPU)(CFC_(UN,LN))( CFARGT14(NCF,KCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) );
1212 #define PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)\
1213  _(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) );
1214 #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)\
1215  _(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) );
1216 #else
1217 #define PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
1218  PROTOCCALLSFSUB0(UN,LN)
1219 #define PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \
1220  PROTOCCALLSFSUB0(UN,LN)
1221 #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) \
1222  PROTOCCALLSFSUB0(UN,LN)
1223 #endif
1224 #endif
1225 
1226 
1227 #ifdef OLD_VAXC /* Allow %CC-I-PARAMNOTUSED. */
1228 #pragma standard
1229 #endif
1230 
1231 
1232 #define CCALLSFSUB1( UN,LN,T1, A1) \
1233  CCALLSFSUB5 (UN,LN,T1,CF_0,CF_0,CF_0,CF_0,A1,0,0,0,0)
1234 #define CCALLSFSUB2( UN,LN,T1,T2, A1,A2) \
1235  CCALLSFSUB5 (UN,LN,T1,T2,CF_0,CF_0,CF_0,A1,A2,0,0,0)
1236 #define CCALLSFSUB3( UN,LN,T1,T2,T3, A1,A2,A3) \
1237  CCALLSFSUB5 (UN,LN,T1,T2,T3,CF_0,CF_0,A1,A2,A3,0,0)
1238 #define CCALLSFSUB4( UN,LN,T1,T2,T3,T4, A1,A2,A3,A4)\
1239  CCALLSFSUB5 (UN,LN,T1,T2,T3,T4,CF_0,A1,A2,A3,A4,0)
1240 #define CCALLSFSUB5( UN,LN,T1,T2,T3,T4,T5, A1,A2,A3,A4,A5) \
1241  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)
1242 #define CCALLSFSUB6( UN,LN,T1,T2,T3,T4,T5,T6, A1,A2,A3,A4,A5,A6) \
1243  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)
1244 #define CCALLSFSUB7( UN,LN,T1,T2,T3,T4,T5,T6,T7, A1,A2,A3,A4,A5,A6,A7) \
1245  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)
1246 #define CCALLSFSUB8( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8, A1,A2,A3,A4,A5,A6,A7,A8) \
1247  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)
1248 #define CCALLSFSUB9( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,A1,A2,A3,A4,A5,A6,A7,A8,A9)\
1249  CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,0)
1250 #define CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA)\
1251  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)
1252 #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)\
1253  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)
1254 #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)\
1255  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)
1256 #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)\
1257  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)
1258 
1259 #ifdef __cplusplus
1260 #define CPPPROTOCLSFSUB0( UN,LN)
1261 #define CPPPROTOCLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
1262 #define CPPPROTOCLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)
1263 #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)
1264 #else
1265 #define CPPPROTOCLSFSUB0(UN,LN) \
1266  PROTOCCALLSFSUB0(UN,LN)
1267 #define CPPPROTOCLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
1268  PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
1269 #define CPPPROTOCLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \
1270  PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)
1271 #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) \
1272  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)
1273 #endif
1274 
1275 #ifdef CFSUBASFUN
1276 #define CCALLSFSUB0(UN,LN) CCALLSFFUN0(UN,LN)
1277 #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)\
1278  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)
1279 #else
1280 /* do{...}while(0) allows if(a==b) FORT(); else BORT(); */
1281 #define CCALLSFSUB0( UN,LN) do{CPPPROTOCLSFSUB0(UN,LN) CFC_(UN,LN)();}while(0)
1282 #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)\
1283 do{VVCF(T1,A1,B1) VVCF(T2,A2,B2) VVCF(T3,A3,B3) VVCF(T4,A4,B4) VVCF(T5,A5,B5) \
1284  VVCF(T6,A6,B6) VVCF(T7,A7,B7) VVCF(T8,A8,B8) VVCF(T9,A9,B9) VVCF(TA,AA,B10) \
1285  VVCF(TB,AB,B11) VVCF(TC,AC,B12) VVCF(TD,AD,B13) VVCF(TE,AE,B14) \
1286  CPPPROTOCLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
1287  ACF(LN,T1,A1,1) ACF(LN,T2,A2,2) ACF(LN,T3,A3,3) \
1288  ACF(LN,T4,A4,4) ACF(LN,T5,A5,5) ACF(LN,T6,A6,6) ACF(LN,T7,A7,7) \
1289  ACF(LN,T8,A8,8) ACF(LN,T9,A9,9) ACF(LN,TA,AA,10) ACF(LN,TB,AB,11) \
1290  ACF(LN,TC,AC,12) ACF(LN,TD,AD,13) ACF(LN,TE,AE,14) \
1291  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) );\
1292  WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) \
1293  WCF(T6,A6,6) WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,AA,10) \
1294  WCF(TB,AB,11) WCF(TC,AC,12) WCF(TD,AD,13) WCF(TE,AE,14) }while(0)
1295 #endif
1296 
1297 
1298 #if MAX_PREPRO_ARGS>31
1299 #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)\
1300  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)
1301 #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)\
1302  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)
1303 #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)\
1304  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)
1305 #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)\
1306  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)
1307 #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)\
1308  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)
1309 
1310 #ifdef CFSUBASFUN
1311 #define CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH, \
1312  TI,TJ,TK, A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) \
1313  CCALLSFFUN20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH, \
1314  TI,TJ,TK, A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK)
1315 #else
1316 #define CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH, \
1317  TI,TJ,TK, A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) \
1318 do{VVCF(T1,A1,B1) VVCF(T2,A2,B2) VVCF(T3,A3,B3) VVCF(T4,A4,B4) VVCF(T5,A5,B5) \
1319  VVCF(T6,A6,B6) VVCF(T7,A7,B7) VVCF(T8,A8,B8) VVCF(T9,A9,B9) VVCF(TA,AA,B10) \
1320  VVCF(TB,AB,B11) VVCF(TC,AC,B12) VVCF(TD,AD,B13) VVCF(TE,AE,B14) VVCF(TF,AF,B15) \
1321  VVCF(TG,AG,B16) VVCF(TH,AH,B17) VVCF(TI,AI,B18) VVCF(TJ,AJ,B19) VVCF(TK,AK,B20) \
1322  CPPPROTOCLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \
1323  ACF(LN,T1,A1,1) ACF(LN,T2,A2,2) ACF(LN,T3,A3,3) ACF(LN,T4,A4,4) \
1324  ACF(LN,T5,A5,5) ACF(LN,T6,A6,6) ACF(LN,T7,A7,7) ACF(LN,T8,A8,8) \
1325  ACF(LN,T9,A9,9) ACF(LN,TA,AA,10) ACF(LN,TB,AB,11) ACF(LN,TC,AC,12) \
1326  ACF(LN,TD,AD,13) ACF(LN,TE,AE,14) ACF(LN,TF,AF,15) ACF(LN,TG,AG,16) \
1327  ACF(LN,TH,AH,17) ACF(LN,TI,AI,18) ACF(LN,TJ,AJ,19) ACF(LN,TK,AK,20) \
1328  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) ); \
1329  WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) WCF(T6,A6,6) \
1330  WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,AA,10) WCF(TB,AB,11) WCF(TC,AC,12) \
1331  WCF(TD,AD,13) WCF(TE,AE,14) WCF(TF,AF,15) WCF(TG,AG,16) WCF(TH,AH,17) WCF(TI,AI,18) \
1332  WCF(TJ,AJ,19) WCF(TK,AK,20) }while(0)
1333 #endif
1334 #endif /* MAX_PREPRO_ARGS */
1335 
1336 #if MAX_PREPRO_ARGS>31
1337 #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)\
1338  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)
1339 #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)\
1340  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)
1341 #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)\
1342  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)
1343 #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)\
1344  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)
1345 #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)\
1346  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)
1347 #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)\
1348  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)
1349 
1350 #ifdef CFSUBASFUN
1351 #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, \
1352  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) \
1353  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, \
1354  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)
1355 #else
1356 #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, \
1357  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) \
1358 do{VVCF(T1,A1,B1) VVCF(T2,A2,B2) VVCF(T3,A3,B3) VVCF(T4,A4,B4) VVCF(T5,A5,B5) \
1359  VVCF(T6,A6,B6) VVCF(T7,A7,B7) VVCF(T8,A8,B8) VVCF(T9,A9,B9) VVCF(TA,AA,B10) \
1360  VVCF(TB,AB,B11) VVCF(TC,AC,B12) VVCF(TD,AD,B13) VVCF(TE,AE,B14) VVCF(TF,AF,B15) \
1361  VVCF(TG,AG,B16) VVCF(TH,AH,B17) VVCF(TI,AI,B18) VVCF(TJ,AJ,B19) VVCF(TK,AK,B20) \
1362  VVCF(TL,AL,B21) VVCF(TM,AM,B22) VVCF(TN,AN,B23) VVCF(TO,AO,B24) VVCF(TP,AP,B25) \
1363  VVCF(TQ,AQ,B26) VVCF(TR,AR,B27) \
1364  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) \
1365  ACF(LN,T1,A1,1) ACF(LN,T2,A2,2) ACF(LN,T3,A3,3) ACF(LN,T4,A4,4) \
1366  ACF(LN,T5,A5,5) ACF(LN,T6,A6,6) ACF(LN,T7,A7,7) ACF(LN,T8,A8,8) \
1367  ACF(LN,T9,A9,9) ACF(LN,TA,AA,10) ACF(LN,TB,AB,11) ACF(LN,TC,AC,12) \
1368  ACF(LN,TD,AD,13) ACF(LN,TE,AE,14) ACF(LN,TF,AF,15) ACF(LN,TG,AG,16) \
1369  ACF(LN,TH,AH,17) ACF(LN,TI,AI,18) ACF(LN,TJ,AJ,19) ACF(LN,TK,AK,20) \
1370  ACF(LN,TL,AL,21) ACF(LN,TM,AM,22) ACF(LN,TN,AN,23) ACF(LN,TO,AO,24) \
1371  ACF(LN,TP,AP,25) ACF(LN,TQ,AQ,26) ACF(LN,TR,AR,27) \
1372  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,\
1373  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) ); \
1374  WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) WCF(T6,A6,6) \
1375  WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,AA,10) WCF(TB,AB,11) WCF(TC,AC,12) \
1376  WCF(TD,AD,13) WCF(TE,AE,14) WCF(TF,AF,15) WCF(TG,AG,16) WCF(TH,AH,17) WCF(TI,AI,18) \
1377  WCF(TJ,AJ,19) WCF(TK,AK,20) WCF(TL,AL,21) WCF(TM,AM,22) WCF(TN,AN,23) WCF(TO,AO,24) \
1378  WCF(TP,AP,25) WCF(TQ,AQ,26) WCF(TR,AR,27) }while(0)
1379 #endif
1380 #endif /* MAX_PREPRO_ARGS */
1381 
1382 /*-------------------------------------------------------------------------*/
1383 
1384 /* UTILITIES FOR C TO CALL FORTRAN FUNCTIONS */
1385 
1386 /*N.B. PROTOCCALLSFFUNn(..) generates code, whether or not the FORTRAN
1387  function is called. Therefore, especially for creator's of C header files
1388  for large FORTRAN libraries which include many functions, to reduce
1389  compile time and object code size, it may be desirable to create
1390  preprocessor directives to allow users to create code for only those
1391  functions which they use. */
1392 
1393 /* The following defines the maximum length string that a function can return.
1394  Of course it may be undefine-d and re-define-d before individual
1395  PROTOCCALLSFFUNn(..) as required. It would also be nice to have this derived
1396  from the individual machines' limits. */
1397 #define MAX_LEN_FORTRAN_FUNCTION_STRING 0x4FE
1398 
1399 /* The following defines a character used by CFORTRAN.H to flag the end of a
1400  string coming out of a FORTRAN routine. */
1401 #define CFORTRAN_NON_CHAR 0x7F
1402 
1403 #ifdef OLD_VAXC /* Prevent %CC-I-PARAMNOTUSED. */
1404 #pragma nostandard
1405 #endif
1406 
1407 #define _SEP_(TN,C,cfCOMMA) _(__SEP_,C)(TN,cfCOMMA)
1408 #define __SEP_0(TN,cfCOMMA)
1409 #define __SEP_1(TN,cfCOMMA) _Icf(2,SEP,TN,cfCOMMA,0)
1410 #define INT_cfSEP(T,B) _(A,B)
1411 #define INTV_cfSEP(T,B) INT_cfSEP(T,B)
1412 #define INTVV_cfSEP(T,B) INT_cfSEP(T,B)
1413 #define INTVVV_cfSEP(T,B) INT_cfSEP(T,B)
1414 #define INTVVVV_cfSEP(T,B) INT_cfSEP(T,B)
1415 #define INTVVVVV_cfSEP(T,B) INT_cfSEP(T,B)
1416 #define INTVVVVVV_cfSEP(T,B) INT_cfSEP(T,B)
1417 #define INTVVVVVVV_cfSEP(T,B) INT_cfSEP(T,B)
1418 #define PINT_cfSEP(T,B) INT_cfSEP(T,B)
1419 #define PVOID_cfSEP(T,B) INT_cfSEP(T,B)
1420 #define ROUTINE_cfSEP(T,B) INT_cfSEP(T,B)
1421 #define SIMPLE_cfSEP(T,B) INT_cfSEP(T,B)
1422 #define VOID_cfSEP(T,B) INT_cfSEP(T,B) /* For FORTRAN calls C subr.s.*/
1423 #define STRING_cfSEP(T,B) INT_cfSEP(T,B)
1424 #define STRINGV_cfSEP(T,B) INT_cfSEP(T,B)
1425 #define PSTRING_cfSEP(T,B) INT_cfSEP(T,B)
1426 #define PSTRINGV_cfSEP(T,B) INT_cfSEP(T,B)
1427 #define PNSTRING_cfSEP(T,B) INT_cfSEP(T,B)
1428 #define PPSTRING_cfSEP(T,B) INT_cfSEP(T,B)
1429 #define ZTRINGV_cfSEP(T,B) INT_cfSEP(T,B)
1430 #define PZTRINGV_cfSEP(T,B) INT_cfSEP(T,B)
1431 
1432 #if defined(SIGNED_BYTE) || !defined(UNSIGNED_BYTE)
1433 #ifdef OLD_VAXC
1434 #define INTEGER_BYTE char /* Old VAXC barfs on 'signed char' */
1435 #else
1436 #define INTEGER_BYTE signed char /* default */
1437 #endif
1438 #else
1439 #define INTEGER_BYTE unsigned char
1440 #endif
1441 #define BYTEVVVVVVV_cfTYPE INTEGER_BYTE
1442 #define DOUBLEVVVVVVV_cfTYPE OOMPH_DOUBLE_PRECISION
1443 #define FLOATVVVVVVV_cfTYPE FORTRAN_REAL
1444 #define INTVVVVVVV_cfTYPE int
1445 #define LOGICALVVVVVVV_cfTYPE int
1446 #define LONGVVVVVVV_cfTYPE long
1447 #define LONGLONGVVVVVVV_cfTYPE LONGLONG /* added by MR December 2005 */
1448 #define SHORTVVVVVVV_cfTYPE short
1449 #define PBYTE_cfTYPE INTEGER_BYTE
1450 #define PDOUBLE_cfTYPE OOMPH_DOUBLE_PRECISION
1451 #define PFLOAT_cfTYPE FORTRAN_REAL
1452 #define PINT_cfTYPE int
1453 #define PLOGICAL_cfTYPE int
1454 #define PLONG_cfTYPE long
1455 #define PLONGLONG_cfTYPE LONGLONG /* added by MR December 2005 */
1456 #define PSHORT_cfTYPE short
1457 
1458 #define CFARGS0(A,T,V,W,X,Y,Z) _3(T,_cf,A)
1459 #define CFARGS1(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V)
1460 #define CFARGS2(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W)
1461 #define CFARGS3(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W,X)
1462 #define CFARGS4(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W,X,Y)
1463 #define CFARGS5(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W,X,Y,Z)
1464 
1465 #define _Icf(N,T,I,X,Y) _(I,_cfINT)(N,T,I,X,Y,0)
1466 #define _Icf4(N,T,I,X,Y,Z) _(I,_cfINT)(N,T,I,X,Y,Z)
1467 #define BYTE_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z)
1468 #define DOUBLE_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INT,B,X,Y,Z,0)
1469 #define FLOAT_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z)
1470 #define INT_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z)
1471 #define LOGICAL_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z)
1472 #define LONG_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z)
1473 #define LONGLONG_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z) /* added by MR December 2005 */
1474 #define SHORT_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z)
1475 #define PBYTE_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z)
1476 #define PDOUBLE_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,PINT,B,X,Y,Z,0)
1477 #define PFLOAT_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z)
1478 #define PINT_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z)
1479 #define PLOGICAL_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z)
1480 #define PLONG_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z)
1481 #define PLONGLONG_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z) /* added by MR December 2005 */
1482 #define PSHORT_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z)
1483 #define BYTEV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z)
1484 #define BYTEVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z)
1485 #define BYTEVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z)
1486 #define BYTEVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z)
1487 #define BYTEVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z)
1488 #define BYTEVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z)
1489 #define BYTEVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z)
1490 #define DOUBLEV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTV,B,X,Y,Z,0)
1491 #define DOUBLEVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVV,B,X,Y,Z,0)
1492 #define DOUBLEVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVV,B,X,Y,Z,0)
1493 #define DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVV,B,X,Y,Z,0)
1494 #define DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVVV,B,X,Y,Z,0)
1495 #define DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVVVV,B,X,Y,Z,0)
1496 #define DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVVVVV,B,X,Y,Z,0)
1497 #define FLOATV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z)
1498 #define FLOATVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z)
1499 #define FLOATVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z)
1500 #define FLOATVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z)
1501 #define FLOATVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z)
1502 #define FLOATVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z)
1503 #define FLOATVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z)
1504 #define INTV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z)
1505 #define INTVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z)
1506 #define INTVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z)
1507 #define INTVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z)
1508 #define INTVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z)
1509 #define INTVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z)
1510 #define INTVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z)
1511 #define LOGICALV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z)
1512 #define LOGICALVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z)
1513 #define LOGICALVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z)
1514 #define LOGICALVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z)
1515 #define LOGICALVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z)
1516 #define LOGICALVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z)
1517 #define LOGICALVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z)
1518 #define LONGV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z)
1519 #define LONGVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z)
1520 #define LONGVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z)
1521 #define LONGVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z)
1522 #define LONGVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z)
1523 #define LONGVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z)
1524 #define LONGVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z)
1525 #define LONGLONGV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z) /* added by MR December 2005 */
1526 #define LONGLONGVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z) /* added by MR December 2005 */
1527 #define LONGLONGVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z) /* added by MR December 2005 */
1528 #define LONGLONGVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) /* added by MR December 2005 */
1529 #define LONGLONGVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) /* added by MR December 2005 */
1530 #define LONGLONGVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) /* added by MR December 2005 */
1531 #define LONGLONGVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) /* added by MR December 2005 */
1532 #define SHORTV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z)
1533 #define SHORTVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z)
1534 #define SHORTVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z)
1535 #define SHORTVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z)
1536 #define SHORTVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z)
1537 #define SHORTVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z)
1538 #define SHORTVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z)
1539 #define PVOID_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,B,B,X,Y,Z,0)
1540 #define ROUTINE_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z)
1541 /*CRAY coughs on the first,
1542  i.e. the usual trouble of not being able to
1543  define macros to macros with arguments.
1544  New ultrix is worse, it coughs on all such uses.
1545  */
1546 /*#define SIMPLE_cfINT PVOID_cfINT*/
1547 #define SIMPLE_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z)
1548 #define VOID_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z)
1549 #define STRING_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z)
1550 #define STRINGV_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z)
1551 #define PSTRING_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z)
1552 #define PSTRINGV_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z)
1553 #define PNSTRING_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z)
1554 #define PPSTRING_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z)
1555 #define ZTRINGV_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z)
1556 #define PZTRINGV_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z)
1557 #define CF_0_cfINT(N,A,B,X,Y,Z)
1558 
1559 
1560 #define UCF(TN,I,C) _SEP_(TN,C,cfCOMMA) _Icf(2,U,TN,_(A,I),0)
1561 #define UUCF(TN,I,C) _SEP_(TN,C,cfCOMMA) _SEP_(TN,1,I)
1562 #define UUUCF(TN,I,C) _SEP_(TN,C,cfCOLON) _Icf(2,U,TN,_(A,I),0)
1563 #define INT_cfU(T,A) _(T,VVVVVVV_cfTYPE) A
1564 #define INTV_cfU(T,A) _(T,VVVVVV_cfTYPE) * A
1565 #define INTVV_cfU(T,A) _(T,VVVVV_cfTYPE) * A
1566 #define INTVVV_cfU(T,A) _(T,VVVV_cfTYPE) * A
1567 #define INTVVVV_cfU(T,A) _(T,VVV_cfTYPE) * A
1568 #define INTVVVVV_cfU(T,A) _(T,VV_cfTYPE) * A
1569 #define INTVVVVVV_cfU(T,A) _(T,V_cfTYPE) * A
1570 #define INTVVVVVVV_cfU(T,A) _(T,_cfTYPE) * A
1571 #define PINT_cfU(T,A) _(T,_cfTYPE) * A
1572 #define PVOID_cfU(T,A) void *A
1573 #define ROUTINE_cfU(T,A) void (*A)(CF_NULL_PROTO)
1574 #define VOID_cfU(T,A) void A /* Needed for C calls FORTRAN sub.s. */
1575 #define STRING_cfU(T,A) char *A /* via VOID and wrapper. */
1576 #define STRINGV_cfU(T,A) char *A
1577 #define PSTRING_cfU(T,A) char *A
1578 #define PSTRINGV_cfU(T,A) char *A
1579 #define ZTRINGV_cfU(T,A) char *A
1580 #define PZTRINGV_cfU(T,A) char *A
1581 
1582 /* VOID breaks U into U and UU. */
1583 #define INT_cfUU(T,A) _(T,VVVVVVV_cfTYPE) A
1584 #define VOID_cfUU(T,A) /* Needed for FORTRAN calls C sub.s. */
1585 #define STRING_cfUU(T,A) char *A
1586 
1587 
1588 #define BYTE_cfPU(A) CFextern INTEGER_BYTE FCALLSC_QUALIFIER A
1589 #define DOUBLE_cfPU(A) CFextern OOMPH_DOUBLE_PRECISION FCALLSC_QUALIFIER A
1590 #if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT))
1591 #if defined (f2cFortran) && ! defined (gFortran)
1592 /* f2c/g77 return double from FORTRAN REAL functions. (KMCCARTY, 2005/12/09) */
1593 #define FLOAT_cfPU(A) CFextern OOMPH_DOUBLE_PRECISION FCALLSC_QUALIFIER A
1594 #else
1595 #define FLOAT_cfPU(A) CFextern FORTRAN_REAL FCALLSC_QUALIFIER A
1596 #endif
1597 #else
1598 #define FLOAT_cfPU(A) CFextern FLOATFUNCTIONTYPE FCALLSC_QUALIFIER A
1599 #endif
1600 #define INT_cfPU(A) CFextern int FCALLSC_QUALIFIER A
1601 #define LOGICAL_cfPU(A) CFextern int FCALLSC_QUALIFIER A
1602 #define LONG_cfPU(A) CFextern long FCALLSC_QUALIFIER A
1603 #define SHORT_cfPU(A) CFextern short FCALLSC_QUALIFIER A
1604 #define STRING_cfPU(A) CFextern void FCALLSC_QUALIFIER A
1605 #define VOID_cfPU(A) CFextern void FCALLSC_QUALIFIER A
1606 
1607 #define BYTE_cfE INTEGER_BYTE A0;
1608 #define DOUBLE_cfE OOMPH_DOUBLE_PRECISION A0;
1609 #if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT))
1610 #define FLOAT_cfE FORTRAN_REAL A0;
1611 #else
1612 #define FLOAT_cfE FORTRAN_REAL AA0; FLOATFUNCTIONTYPE A0;
1613 #endif
1614 #define INT_cfE int A0;
1615 #define LOGICAL_cfE int A0;
1616 #define LONG_cfE long A0;
1617 #define SHORT_cfE short A0;
1618 #define VOID_cfE
1619 #ifdef vmsFortran
1620 #define STRING_cfE static char AA0[1+MAX_LEN_FORTRAN_FUNCTION_STRING]; \
1621  static fstring A0 = \
1622  {MAX_LEN_FORTRAN_FUNCTION_STRING,DSC$K_DTYPE_T,DSC$K_CLASS_S,AA0};\
1623  memset(AA0, CFORTRAN_NON_CHAR, MAX_LEN_FORTRAN_FUNCTION_STRING);\
1624  *(AA0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0';
1625 #else
1626 #ifdef CRAYFortran
1627 #define STRING_cfE static char AA0[1+MAX_LEN_FORTRAN_FUNCTION_STRING]; \
1628  static _fcd A0; *(AA0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0';\
1629  memset(AA0,CFORTRAN_NON_CHAR, MAX_LEN_FORTRAN_FUNCTION_STRING);\
1630  A0 = _cptofcd(AA0,MAX_LEN_FORTRAN_FUNCTION_STRING);
1631 #else
1632 /* 'cc: SC3.0.1 13 Jul 1994' barfs on char A0[0x4FE+1];
1633  * char A0[0x4FE +1]; char A0[1+0x4FE]; are both OK. */
1634 #define STRING_cfE static char A0[1+MAX_LEN_FORTRAN_FUNCTION_STRING]; \
1635  memset(A0, CFORTRAN_NON_CHAR, \
1636  MAX_LEN_FORTRAN_FUNCTION_STRING); \
1637  *(A0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0';
1638 #endif
1639 #endif
1640 /* ESTRING must use static char. array which is guaranteed to exist after
1641  function returns. */
1642 
1643 /* N.B.i) The diff. for 0 (Zero) and >=1 arguments.
1644  ii)That the following create an unmatched bracket, i.e. '(', which
1645  must of course be matched in the call.
1646  iii)Commas must be handled very carefully */
1647 #define INT_cfGZ(T,UN,LN) A0=CFC_(UN,LN)(
1648 #define VOID_cfGZ(T,UN,LN) CFC_(UN,LN)(
1649 #ifdef vmsFortran
1650 #define STRING_cfGZ(T,UN,LN) CFC_(UN,LN)(&A0
1651 #else
1652 #if defined(CRAYFortran) || defined(AbsoftUNIXFortran) || defined(AbsoftProFortran)
1653 #define STRING_cfGZ(T,UN,LN) CFC_(UN,LN)( A0
1654 #else
1655 #define STRING_cfGZ(T,UN,LN) CFC_(UN,LN)( A0,MAX_LEN_FORTRAN_FUNCTION_STRING
1656 #endif
1657 #endif
1658 
1659 #define INT_cfG(T,UN,LN) INT_cfGZ(T,UN,LN)
1660 #define VOID_cfG(T,UN,LN) VOID_cfGZ(T,UN,LN)
1661 #define STRING_cfG(T,UN,LN) STRING_cfGZ(T,UN,LN), /*, is only diff. from _cfG*/
1662 
1663 #define BYTEVVVVVVV_cfPP
1664 #define INTVVVVVVV_cfPP /* These complement FLOATVVVVVVV_cfPP. */
1665 #define DOUBLEVVVVVVV_cfPP
1666 #define LOGICALVVVVVVV_cfPP
1667 #define LONGVVVVVVV_cfPP
1668 #define SHORTVVVVVVV_cfPP
1669 #define PBYTE_cfPP
1670 #define PINT_cfPP
1671 #define PDOUBLE_cfPP
1672 #define PLOGICAL_cfPP
1673 #define PLONG_cfPP
1674 #define PSHORT_cfPP
1675 #define PFLOAT_cfPP FLOATVVVVVVV_cfPP
1676 
1677 #define BCF(TN,AN,C) _SEP_(TN,C,cfCOMMA) _Icf(2,B,TN,AN,0)
1678 #define INT_cfB(T,A) (_(T,VVVVVVV_cfTYPE)) A
1679 #define INTV_cfB(T,A) A
1680 #define INTVV_cfB(T,A) (A)[0]
1681 #define INTVVV_cfB(T,A) (A)[0][0]
1682 #define INTVVVV_cfB(T,A) (A)[0][0][0]
1683 #define INTVVVVV_cfB(T,A) (A)[0][0][0][0]
1684 #define INTVVVVVV_cfB(T,A) (A)[0][0][0][0][0]
1685 #define INTVVVVVVV_cfB(T,A) (A)[0][0][0][0][0][0]
1686 #define PINT_cfB(T,A) _(T,_cfPP)&A
1687 #define STRING_cfB(T,A) (char *) A
1688 #define STRINGV_cfB(T,A) (char *) A
1689 #define PSTRING_cfB(T,A) (char *) A
1690 #define PSTRINGV_cfB(T,A) (char *) A
1691 #define PVOID_cfB(T,A) (void *) A
1692 #define ROUTINE_cfB(T,A) (cfCAST_FUNCTION)A
1693 #define ZTRINGV_cfB(T,A) (char *) A
1694 #define PZTRINGV_cfB(T,A) (char *) A
1695 
1696 #define SCF(TN,NAME,I,A) _(TN,_cfSTR)(3,S,NAME,I,A,0,0)
1697 #define DEFAULT_cfS(M,I,A)
1698 #define LOGICAL_cfS(M,I,A)
1699 #define PLOGICAL_cfS(M,I,A)
1700 #define STRING_cfS(M,I,A) ,sizeof(A)
1701 #define STRINGV_cfS(M,I,A) ,( (unsigned)0xFFFF*firstindexlength(A) \
1702  +secondindexlength(A))
1703 #define PSTRING_cfS(M,I,A) ,sizeof(A)
1704 #define PSTRINGV_cfS(M,I,A) STRINGV_cfS(M,I,A)
1705 #define ZTRINGV_cfS(M,I,A)
1706 #define PZTRINGV_cfS(M,I,A)
1707 
1708 #define HCF(TN,I) _(TN,_cfSTR)(3,H,cfCOMMA, H,_(C,I),0,0)
1709 #define HHCF(TN,I) _(TN,_cfSTR)(3,H,cfCOMMA,HH,_(C,I),0,0)
1710 #define HHHCF(TN,I) _(TN,_cfSTR)(3,H,cfCOLON, H,_(C,I),0,0)
1711 #define H_CF_SPECIAL unsigned
1712 #define HH_CF_SPECIAL
1713 #define DEFAULT_cfH(M,I,A)
1714 #define LOGICAL_cfH(S,U,B)
1715 #define PLOGICAL_cfH(S,U,B)
1716 #define STRING_cfH(S,U,B) _(A,S) _(U,_CF_SPECIAL) B
1717 #define STRINGV_cfH(S,U,B) STRING_cfH(S,U,B)
1718 #define PSTRING_cfH(S,U,B) STRING_cfH(S,U,B)
1719 #define PSTRINGV_cfH(S,U,B) STRING_cfH(S,U,B)
1720 #define PNSTRING_cfH(S,U,B) STRING_cfH(S,U,B)
1721 #define PPSTRING_cfH(S,U,B) STRING_cfH(S,U,B)
1722 #define ZTRINGV_cfH(S,U,B)
1723 #define PZTRINGV_cfH(S,U,B)
1724 
1725 /* Need VOID_cfSTR because Absoft forced function types go through _cfSTR. */
1726 /* No spaces inside expansion. They screws up macro catenation kludge. */
1727 #define VOID_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1728 #define BYTE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1729 #define DOUBLE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1730 #define FLOAT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1731 #define INT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1732 #define LOGICAL_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,LOGICAL,A,B,C,D,E)
1733 #define LONG_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1734 #define LONGLONG_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) /* added by MR December 2005 */
1735 #define SHORT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1736 #define BYTEV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1737 #define BYTEVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1738 #define BYTEVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1739 #define BYTEVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1740 #define BYTEVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1741 #define BYTEVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1742 #define BYTEVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1743 #define DOUBLEV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1744 #define DOUBLEVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1745 #define DOUBLEVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1746 #define DOUBLEVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1747 #define DOUBLEVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1748 #define DOUBLEVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1749 #define DOUBLEVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1750 #define FLOATV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1751 #define FLOATVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1752 #define FLOATVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1753 #define FLOATVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1754 #define FLOATVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1755 #define FLOATVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1756 #define FLOATVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1757 #define INTV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1758 #define INTVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1759 #define INTVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1760 #define INTVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1761 #define INTVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1762 #define INTVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1763 #define INTVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1764 #define LOGICALV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1765 #define LOGICALVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1766 #define LOGICALVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1767 #define LOGICALVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1768 #define LOGICALVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1769 #define LOGICALVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1770 #define LOGICALVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1771 #define LONGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1772 #define LONGVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1773 #define LONGVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1774 #define LONGVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1775 #define LONGVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1776 #define LONGVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1777 #define LONGVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1778 #define LONGLONGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) /* added by MR December 2005 */
1779 #define LONGLONGVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) /* added by MR December 2005 */
1780 #define LONGLONGVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) /* added by MR December 2005 */
1781 #define LONGLONGVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) /* added by MR December 2005 */
1782 #define LONGLONGVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) /* added by MR December 2005 */
1783 #define LONGLONGVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) /* added by MR December 2005 */
1784 #define LONGLONGVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) /* added by MR December 2005 */
1785 #define SHORTV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1786 #define SHORTVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1787 #define SHORTVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1788 #define SHORTVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1789 #define SHORTVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1790 #define SHORTVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1791 #define SHORTVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1792 #define PBYTE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1793 #define PDOUBLE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1794 #define PFLOAT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1795 #define PINT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1796 #define PLOGICAL_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PLOGICAL,A,B,C,D,E)
1797 #define PLONG_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1798 #define PLONGLONG_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) /* added by MR December 2005 */
1799 #define PSHORT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1800 #define STRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,STRING,A,B,C,D,E)
1801 #define PSTRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PSTRING,A,B,C,D,E)
1802 #define STRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,STRINGV,A,B,C,D,E)
1803 #define PSTRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PSTRINGV,A,B,C,D,E)
1804 #define PNSTRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PNSTRING,A,B,C,D,E)
1805 #define PPSTRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PPSTRING,A,B,C,D,E)
1806 #define PVOID_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1807 #define ROUTINE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1808 #define SIMPLE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1809 #define ZTRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,ZTRINGV,A,B,C,D,E)
1810 #define PZTRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PZTRINGV,A,B,C,D,E)
1811 #define CF_0_cfSTR(N,T,A,B,C,D,E)
1812 
1813 /* See ACF table comments, which explain why CCF was split into two. */
1814 #define CCF(NAME,TN,I) _(TN,_cfSTR)(5,C,NAME,I,_(A,I),_(B,I),_(C,I))
1815 #define DEFAULT_cfC(M,I,A,B,C)
1816 #define LOGICAL_cfC(M,I,A,B,C) A=C2FLOGICAL( A);
1817 #define PLOGICAL_cfC(M,I,A,B,C) *A=C2FLOGICAL(*A);
1818 #ifdef vmsFortran
1819 #define STRING_cfC(M,I,A,B,C) (B.clen=strlen(A),B.f.dsc$a_pointer=A, \
1820  C==sizeof(char*)||C==(unsigned)(B.clen+1)?B.f.dsc$w_length=B.clen: \
1821  (memset((A)+B.clen,' ',C-B.clen-1),A[B.f.dsc$w_length=C-1]='\0'));
1822  /* PSTRING_cfC to beware of array A which does not contain any \0. */
1823 #define PSTRING_cfC(M,I,A,B,C) (B.dsc$a_pointer=A, C==sizeof(char*) ? \
1824  B.dsc$w_length=strlen(A): (A[C-1]='\0',B.dsc$w_length=strlen(A), \
1825  memset((A)+B.dsc$w_length,' ',C-B.dsc$w_length-1), B.dsc$w_length=C-1));
1826 #else
1827 #define STRING_cfC(M,I,A,B,C) (B.nombre=A,B.clen=strlen(A), \
1828  C==sizeof(char*)||C==(unsigned)(B.clen+1)?B.flen=B.clen: \
1829  (memset(B.nombre+B.clen,' ',C-B.clen-1),B.nombre[B.flen=C-1]='\0'));
1830 #define PSTRING_cfC(M,I,A,B,C) (C==sizeof(char*)? B=strlen(A): \
1831  (A[C-1]='\0',B=strlen(A),memset((A)+B,' ',C-B-1),B=C-1));
1832 #endif
1833  /* For CRAYFortran for (P)STRINGV_cfC, B.fs is set, but irrelevant. */
1834 #define STRINGV_cfC(M,I,A,B,C) \
1835  AATRINGV_cfA( A,B,(C/0xFFFF)*(C%0xFFFF),C/0xFFFF,C%0xFFFF)
1836 #define PSTRINGV_cfC(M,I,A,B,C) \
1837  APATRINGV_cfA( A,B,(C/0xFFFF)*(C%0xFFFF),C/0xFFFF,C%0xFFFF)
1838 #define ZTRINGV_cfC(M,I,A,B,C) \
1839  AATRINGV_cfA( A,B, (_3(M,_ELEMS_,I))*((_3(M,_ELEMLEN_,I))+1), \
1840  (_3(M,_ELEMS_,I)), (_3(M,_ELEMLEN_,I))+1 )
1841 #define PZTRINGV_cfC(M,I,A,B,C) \
1842  APATRINGV_cfA( A,B, (_3(M,_ELEMS_,I))*((_3(M,_ELEMLEN_,I))+1), \
1843  (_3(M,_ELEMS_,I)), (_3(M,_ELEMLEN_,I))+1 )
1844 
1845 #define BYTE_cfCCC(A,B) &A
1846 #define DOUBLE_cfCCC(A,B) &A
1847 #if !defined(__CF__KnR)
1848 #define FLOAT_cfCCC(A,B) &A
1849  /* Although the VAX doesn't, at least the */
1850 #else /* HP and K&R mips promote float arg.'s of */
1851 #define FLOAT_cfCCC(A,B) &B /* unprototyped functions to double. Cannot */
1852 #endif /* use A here to pass the argument to FORTRAN. */
1853 #define INT_cfCCC(A,B) &A
1854 #define LOGICAL_cfCCC(A,B) &A
1855 #define LONG_cfCCC(A,B) &A
1856 #define SHORT_cfCCC(A,B) &A
1857 #define PBYTE_cfCCC(A,B) A
1858 #define PDOUBLE_cfCCC(A,B) A
1859 #define PFLOAT_cfCCC(A,B) A
1860 #define PINT_cfCCC(A,B) A
1861 #define PLOGICAL_cfCCC(A,B) B=A /* B used to keep a common W table. */
1862 #define PLONG_cfCCC(A,B) A
1863 #define PSHORT_cfCCC(A,B) A
1864 
1865 #define CCCF(TN,I,M) _SEP_(TN,M,cfCOMMA) _Icf(3,CC,TN,_(A,I),_(B,I))
1866 #define INT_cfCC(T,A,B) _(T,_cfCCC)(A,B)
1867 #define INTV_cfCC(T,A,B) A
1868 #define INTVV_cfCC(T,A,B) A
1869 #define INTVVV_cfCC(T,A,B) A
1870 #define INTVVVV_cfCC(T,A,B) A
1871 #define INTVVVVV_cfCC(T,A,B) A
1872 #define INTVVVVVV_cfCC(T,A,B) A
1873 #define INTVVVVVVV_cfCC(T,A,B) A
1874 #define PINT_cfCC(T,A,B) _(T,_cfCCC)(A,B)
1875 #define PVOID_cfCC(T,A,B) A
1876 #if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran)
1877 #define ROUTINE_cfCC(T,A,B) &A
1878 #else
1879 #define ROUTINE_cfCC(T,A,B) A
1880 #endif
1881 #define SIMPLE_cfCC(T,A,B) A
1882 #ifdef vmsFortran
1883 #define STRING_cfCC(T,A,B) &B.f
1884 #define STRINGV_cfCC(T,A,B) &B
1885 #define PSTRING_cfCC(T,A,B) &B
1886 #define PSTRINGV_cfCC(T,A,B) &B
1887 #else
1888 #ifdef CRAYFortran
1889 #define STRING_cfCC(T,A,B) _cptofcd(A,B.flen)
1890 #define STRINGV_cfCC(T,A,B) _cptofcd(B.s,B.flen)
1891 #define PSTRING_cfCC(T,A,B) _cptofcd(A,B)
1892 #define PSTRINGV_cfCC(T,A,B) _cptofcd(A,B.flen)
1893 #else
1894 #define STRING_cfCC(T,A,B) A
1895 #define STRINGV_cfCC(T,A,B) B.fs
1896 #define PSTRING_cfCC(T,A,B) A
1897 #define PSTRINGV_cfCC(T,A,B) B.fs
1898 #endif
1899 #endif
1900 #define ZTRINGV_cfCC(T,A,B) STRINGV_cfCC(T,A,B)
1901 #define PZTRINGV_cfCC(T,A,B) PSTRINGV_cfCC(T,A,B)
1902 
1903 #define BYTE_cfX return A0;
1904 #define DOUBLE_cfX return A0;
1905 #if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT))
1906 #define FLOAT_cfX return A0;
1907 #else
1908 #define FLOAT_cfX ASSIGNFLOAT(AA0,A0); return AA0;
1909 #endif
1910 #define INT_cfX return A0;
1911 #define LOGICAL_cfX return F2CLOGICAL(A0);
1912 #define LONG_cfX return A0;
1913 #define SHORT_cfX return A0;
1914 #define VOID_cfX return ;
1915 #if defined(vmsFortran) || defined(CRAYFortran)
1916 #define STRING_cfX return kill_trailing( \
1917  kill_trailing(AA0,CFORTRAN_NON_CHAR),' ');
1918 #else
1919 #define STRING_cfX return kill_trailing( \
1920  kill_trailing( A0,CFORTRAN_NON_CHAR),' ');
1921 #endif
1922 
1923 #define CFFUN(NAME) _(__cf__,NAME)
1924 
1925 /* Note that we don't use LN here, but we keep it for consistency. */
1926 #define CCALLSFFUN0(UN,LN) CFFUN(UN)()
1927 
1928 #ifdef OLD_VAXC /* Allow %CC-I-PARAMNOTUSED. */
1929 #pragma standard
1930 #endif
1931 
1932 #define CCALLSFFUN1( UN,LN,T1, A1) \
1933  CCALLSFFUN5 (UN,LN,T1,CF_0,CF_0,CF_0,CF_0,A1,0,0,0,0)
1934 #define CCALLSFFUN2( UN,LN,T1,T2, A1,A2) \
1935  CCALLSFFUN5 (UN,LN,T1,T2,CF_0,CF_0,CF_0,A1,A2,0,0,0)
1936 #define CCALLSFFUN3( UN,LN,T1,T2,T3, A1,A2,A3) \
1937  CCALLSFFUN5 (UN,LN,T1,T2,T3,CF_0,CF_0,A1,A2,A3,0,0)
1938 #define CCALLSFFUN4( UN,LN,T1,T2,T3,T4, A1,A2,A3,A4)\
1939  CCALLSFFUN5 (UN,LN,T1,T2,T3,T4,CF_0,A1,A2,A3,A4,0)
1940 #define CCALLSFFUN5( UN,LN,T1,T2,T3,T4,T5, A1,A2,A3,A4,A5) \
1941  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)
1942 #define CCALLSFFUN6( UN,LN,T1,T2,T3,T4,T5,T6, A1,A2,A3,A4,A5,A6) \
1943  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)
1944 #define CCALLSFFUN7( UN,LN,T1,T2,T3,T4,T5,T6,T7, A1,A2,A3,A4,A5,A6,A7) \
1945  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)
1946 #define CCALLSFFUN8( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8, A1,A2,A3,A4,A5,A6,A7,A8) \
1947  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)
1948 #define CCALLSFFUN9( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,A1,A2,A3,A4,A5,A6,A7,A8,A9)\
1949  CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,0)
1950 #define CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA)\
1951  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)
1952 #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)\
1953  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)
1954 #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)\
1955  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)
1956 #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)\
1957  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)
1958 
1959 #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)\
1960 ((CFFUN(UN)( BCF(T1,A1,0) BCF(T2,A2,1) BCF(T3,A3,1) BCF(T4,A4,1) BCF(T5,A5,1) \
1961  BCF(T6,A6,1) BCF(T7,A7,1) BCF(T8,A8,1) BCF(T9,A9,1) BCF(TA,AA,1) \
1962  BCF(TB,AB,1) BCF(TC,AC,1) BCF(TD,AD,1) BCF(TE,AE,1) \
1963  SCF(T1,LN,1,A1) SCF(T2,LN,2,A2) SCF(T3,LN,3,A3) SCF(T4,LN,4,A4) \
1964  SCF(T5,LN,5,A5) SCF(T6,LN,6,A6) SCF(T7,LN,7,A7) SCF(T8,LN,8,A8) \
1965  SCF(T9,LN,9,A9) SCF(TA,LN,10,AA) SCF(TB,LN,11,AB) SCF(TC,LN,12,AC) \
1966  SCF(TD,LN,13,AD) SCF(TE,LN,14,AE))))
1967 
1968 /* N.B. Create a separate function instead of using (call function, function
1969 value here) because in order to create the variables needed for the input
1970 arg.'s which may be const.'s one has to do the creation within {}, but these
1971 can never be placed within ()'s. Therefore one must create wrapper functions.
1972 gcc, on the other hand may be able to avoid the wrapper functions. */
1973 
1974 /* Prototypes are needed to correctly handle the value returned correctly. N.B.
1975 Can only have prototype arg.'s with difficulty, a la G... table since FORTRAN
1976 functions returning strings have extra arg.'s. Don't bother, since this only
1977 causes a compiler warning to come up when one uses FCALLSCFUNn and CCALLSFFUNn
1978 for the same function in the same source code. Something done by the experts in
1979 debugging only.*/
1980 
1981 #define PROTOCCALLSFFUN0(F,UN,LN) \
1982 _(F,_cfPU)( CFC_(UN,LN))(CF_NULL_PROTO); \
1983 static _Icf(2,U,F,CFFUN(UN),0)() {_(F,_cfE) _Icf(3,GZ,F,UN,LN) ABSOFT_cf1(F));_(F,_cfX)}
1984 
1985 #define PROTOCCALLSFFUN1( T0,UN,LN,T1) \
1986  PROTOCCALLSFFUN5 (T0,UN,LN,T1,CF_0,CF_0,CF_0,CF_0)
1987 #define PROTOCCALLSFFUN2( T0,UN,LN,T1,T2) \
1988  PROTOCCALLSFFUN5 (T0,UN,LN,T1,T2,CF_0,CF_0,CF_0)
1989 #define PROTOCCALLSFFUN3( T0,UN,LN,T1,T2,T3) \
1990  PROTOCCALLSFFUN5 (T0,UN,LN,T1,T2,T3,CF_0,CF_0)
1991 #define PROTOCCALLSFFUN4( T0,UN,LN,T1,T2,T3,T4) \
1992  PROTOCCALLSFFUN5 (T0,UN,LN,T1,T2,T3,T4,CF_0)
1993 #define PROTOCCALLSFFUN5( T0,UN,LN,T1,T2,T3,T4,T5) \
1994  PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0)
1995 #define PROTOCCALLSFFUN6( T0,UN,LN,T1,T2,T3,T4,T5,T6) \
1996  PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0)
1997 #define PROTOCCALLSFFUN7( T0,UN,LN,T1,T2,T3,T4,T5,T6,T7) \
1998  PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0)
1999 #define PROTOCCALLSFFUN8( T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \
2000  PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0)
2001 #define PROTOCCALLSFFUN9( T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \
2002  PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0)
2003 #define PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \
2004  PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0)
2005 #define PROTOCCALLSFFUN11(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \
2006  PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0)
2007 #define PROTOCCALLSFFUN12(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \
2008  PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0)
2009 #define PROTOCCALLSFFUN13(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \
2010  PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0)
2011 
2012 /* HP/UX 9.01 cc requires the blank between '_Icf(3,G,T0,UN,LN) CCCF(T1,1,0)' */
2013 
2014 #ifndef __CF__KnR
2015 #define PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
2016  _(T0,_cfPU)(CFC_(UN,LN))(CF_NULL_PROTO); static _Icf(2,U,T0,CFFUN(UN),0)( \
2017  CFARGT14FS(UCF,HCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) ) \
2018 { CFARGT14S(VCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) _(T0,_cfE) \
2019  CCF(LN,T1,1) CCF(LN,T2,2) CCF(LN,T3,3) CCF(LN,T4,4) CCF(LN,T5,5) \
2020  CCF(LN,T6,6) CCF(LN,T7,7) CCF(LN,T8,8) CCF(LN,T9,9) CCF(LN,TA,10) \
2021  CCF(LN,TB,11) CCF(LN,TC,12) CCF(LN,TD,13) CCF(LN,TE,14) _Icf(3,G,T0,UN,LN) \
2022  CFARGT14(CCCF,JCF,ABSOFT_cf1(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)); \
2023  WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) \
2024  WCF(T6,A6,6) WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,A10,10) \
2025  WCF(TB,A11,11) WCF(TC,A12,12) WCF(TD,A13,13) WCF(TE,A14,14) _(T0,_cfX)}
2026 #else
2027 #define PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
2028  _(T0,_cfPU)(CFC_(UN,LN))(CF_NULL_PROTO); static _Icf(2,U,T0,CFFUN(UN),0)( \
2029  CFARGT14FS(UUCF,HHCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) ) \
2030  CFARGT14FS(UUUCF,HHHCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) ; \
2031 { CFARGT14S(VCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) _(T0,_cfE) \
2032  CCF(LN,T1,1) CCF(LN,T2,2) CCF(LN,T3,3) CCF(LN,T4,4) CCF(LN,T5,5) \
2033  CCF(LN,T6,6) CCF(LN,T7,7) CCF(LN,T8,8) CCF(LN,T9,9) CCF(LN,TA,10) \
2034  CCF(LN,TB,11) CCF(LN,TC,12) CCF(LN,TD,13) CCF(LN,TE,14) _Icf(3,G,T0,UN,LN) \
2035  CFARGT14(CCCF,JCF,ABSOFT_cf1(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)); \
2036  WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) \
2037  WCF(T6,A6,6) WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,A10,10) \
2038  WCF(TB,A11,11) WCF(TC,A12,12) WCF(TD,A13,13) WCF(TE,A14,14) _(T0,_cfX)}
2039 #endif
2040 
2041 /*-------------------------------------------------------------------------*/
2042 
2043 /* UTILITIES FOR FORTRAN TO CALL C ROUTINES */
2044 
2045 #ifdef OLD_VAXC /* Prevent %CC-I-PARAMNOTUSED. */
2046 #pragma nostandard
2047 #endif
2048 
2049 #if defined(vmsFortran) || defined(CRAYFortran)
2050 #define DCF(TN,I)
2051 #define DDCF(TN,I)
2052 #define DDDCF(TN,I)
2053 #else
2054 #define DCF(TN,I) HCF(TN,I)
2055 #define DDCF(TN,I) HHCF(TN,I)
2056 #define DDDCF(TN,I) HHHCF(TN,I)
2057 #endif
2058 
2059 #define QCF(TN,I) _(TN,_cfSTR)(1,Q,_(B,I), 0,0,0,0)
2060 #define DEFAULT_cfQ(B)
2061 #define LOGICAL_cfQ(B)
2062 #define PLOGICAL_cfQ(B)
2063 #define STRINGV_cfQ(B) char *B; unsigned int _(B,N);
2064 #define STRING_cfQ(B) char *B=NULL;
2065 #define PSTRING_cfQ(B) char *B=NULL;
2066 #define PSTRINGV_cfQ(B) STRINGV_cfQ(B)
2067 #define PNSTRING_cfQ(B) char *B=NULL;
2068 #define PPSTRING_cfQ(B)
2069 
2070 #ifdef __sgi /* Else SGI gives warning 182 contrary to its C LRM A.17.7 */
2071 #define ROUTINE_orig *(void**)&
2072 #else
2073 #define ROUTINE_orig (void *)
2074 #endif
2075 
2076 #define ROUTINE_1 ROUTINE_orig
2077 #define ROUTINE_2 ROUTINE_orig
2078 #define ROUTINE_3 ROUTINE_orig
2079 #define ROUTINE_4 ROUTINE_orig
2080 #define ROUTINE_5 ROUTINE_orig
2081 #define ROUTINE_6 ROUTINE_orig
2082 #define ROUTINE_7 ROUTINE_orig
2083 #define ROUTINE_8 ROUTINE_orig
2084 #define ROUTINE_9 ROUTINE_orig
2085 #define ROUTINE_10 ROUTINE_orig
2086 #define ROUTINE_11 ROUTINE_orig
2087 #define ROUTINE_12 ROUTINE_orig
2088 #define ROUTINE_13 ROUTINE_orig
2089 #define ROUTINE_14 ROUTINE_orig
2090 #define ROUTINE_15 ROUTINE_orig
2091 #define ROUTINE_16 ROUTINE_orig
2092 #define ROUTINE_17 ROUTINE_orig
2093 #define ROUTINE_18 ROUTINE_orig
2094 #define ROUTINE_19 ROUTINE_orig
2095 #define ROUTINE_20 ROUTINE_orig
2096 #define ROUTINE_21 ROUTINE_orig
2097 #define ROUTINE_22 ROUTINE_orig
2098 #define ROUTINE_23 ROUTINE_orig
2099 #define ROUTINE_24 ROUTINE_orig
2100 #define ROUTINE_25 ROUTINE_orig
2101 #define ROUTINE_26 ROUTINE_orig
2102 #define ROUTINE_27 ROUTINE_orig
2103 
2104 #define TCF(NAME,TN,I,M) _SEP_(TN,M,cfCOMMA) _(TN,_cfT)(NAME,I,_(A,I),_(B,I),_(C,I))
2105 #define BYTE_cfT(M,I,A,B,D) *A
2106 #define DOUBLE_cfT(M,I,A,B,D) *A
2107 #define FLOAT_cfT(M,I,A,B,D) *A
2108 #define INT_cfT(M,I,A,B,D) *A
2109 #define LOGICAL_cfT(M,I,A,B,D) F2CLOGICAL(*A)
2110 #define LONG_cfT(M,I,A,B,D) *A
2111 #define LONGLONG_cfT(M,I,A,B,D) *A /* added by MR December 2005 */
2112 #define SHORT_cfT(M,I,A,B,D) *A
2113 #define BYTEV_cfT(M,I,A,B,D) A
2114 #define DOUBLEV_cfT(M,I,A,B,D) A
2115 #define FLOATV_cfT(M,I,A,B,D) VOIDP A
2116 #define INTV_cfT(M,I,A,B,D) A
2117 #define LOGICALV_cfT(M,I,A,B,D) A
2118 #define LONGV_cfT(M,I,A,B,D) A
2119 #define LONGLONGV_cfT(M,I,A,B,D) A /* added by MR December 2005 */
2120 #define SHORTV_cfT(M,I,A,B,D) A
2121 #define BYTEVV_cfT(M,I,A,B,D) (void *)A /* We have to cast to void *,*/
2122 #define BYTEVVV_cfT(M,I,A,B,D) (void *)A /* since we don't know the */
2123 #define BYTEVVVV_cfT(M,I,A,B,D) (void *)A /* dimensions of the array. */
2124 #define BYTEVVVVV_cfT(M,I,A,B,D) (void *)A /* i.e. Unfortunately, can't */
2125 #define BYTEVVVVVV_cfT(M,I,A,B,D) (void *)A /* check that the type */
2126 #define BYTEVVVVVVV_cfT(M,I,A,B,D) (void *)A /* matches the prototype. */
2127 #define DOUBLEVV_cfT(M,I,A,B,D) (void *)A
2128 #define DOUBLEVVV_cfT(M,I,A,B,D) (void *)A
2129 #define DOUBLEVVVV_cfT(M,I,A,B,D) (void *)A
2130 #define DOUBLEVVVVV_cfT(M,I,A,B,D) (void *)A
2131 #define DOUBLEVVVVVV_cfT(M,I,A,B,D) (void *)A
2132 #define DOUBLEVVVVVVV_cfT(M,I,A,B,D) (void *)A
2133 #define FLOATVV_cfT(M,I,A,B,D) (void *)A
2134 #define FLOATVVV_cfT(M,I,A,B,D) (void *)A
2135 #define FLOATVVVV_cfT(M,I,A,B,D) (void *)A
2136 #define FLOATVVVVV_cfT(M,I,A,B,D) (void *)A
2137 #define FLOATVVVVVV_cfT(M,I,A,B,D) (void *)A
2138 #define FLOATVVVVVVV_cfT(M,I,A,B,D) (void *)A
2139 #define INTVV_cfT(M,I,A,B,D) (void *)A
2140 #define INTVVV_cfT(M,I,A,B,D) (void *)A
2141 #define INTVVVV_cfT(M,I,A,B,D) (void *)A
2142 #define INTVVVVV_cfT(M,I,A,B,D) (void *)A
2143 #define INTVVVVVV_cfT(M,I,A,B,D) (void *)A
2144 #define INTVVVVVVV_cfT(M,I,A,B,D) (void *)A
2145 #define LOGICALVV_cfT(M,I,A,B,D) (void *)A
2146 #define LOGICALVVV_cfT(M,I,A,B,D) (void *)A
2147 #define LOGICALVVVV_cfT(M,I,A,B,D) (void *)A
2148 #define LOGICALVVVVV_cfT(M,I,A,B,D) (void *)A
2149 #define LOGICALVVVVVV_cfT(M,I,A,B,D) (void *)A
2150 #define LOGICALVVVVVVV_cfT(M,I,A,B,D) (void *)A
2151 #define LONGVV_cfT(M,I,A,B,D) (void *)A
2152 #define LONGVVV_cfT(M,I,A,B,D) (void *)A
2153 #define LONGVVVV_cfT(M,I,A,B,D) (void *)A
2154 #define LONGVVVVV_cfT(M,I,A,B,D) (void *)A
2155 #define LONGVVVVVV_cfT(M,I,A,B,D) (void *)A
2156 #define LONGVVVVVVV_cfT(M,I,A,B,D) (void *)A
2157 #define LONGLONGVV_cfT(M,I,A,B,D) (void *)A /* added by MR December 2005 */
2158 #define LONGLONGVVV_cfT(M,I,A,B,D) (void *)A /* added by MR December 2005 */
2159 #define LONGLONGVVVV_cfT(M,I,A,B,D) (void *)A /* added by MR December 2005 */
2160 #define LONGLONGVVVVV_cfT(M,I,A,B,D) (void *)A /* added by MR December 2005 */
2161 #define LONGLONGVVVVVV_cfT(M,I,A,B,D) (void *)A /* added by MR December 2005 */
2162 #define LONGLONGVVVVVVV_cfT(M,I,A,B,D) (void *)A /* added by MR December 2005 */
2163 #define SHORTVV_cfT(M,I,A,B,D) (void *)A
2164 #define SHORTVVV_cfT(M,I,A,B,D) (void *)A
2165 #define SHORTVVVV_cfT(M,I,A,B,D) (void *)A
2166 #define SHORTVVVVV_cfT(M,I,A,B,D) (void *)A
2167 #define SHORTVVVVVV_cfT(M,I,A,B,D) (void *)A
2168 #define SHORTVVVVVVV_cfT(M,I,A,B,D) (void *)A
2169 #define PBYTE_cfT(M,I,A,B,D) A
2170 #define PDOUBLE_cfT(M,I,A,B,D) A
2171 #define PFLOAT_cfT(M,I,A,B,D) VOIDP A
2172 #define PINT_cfT(M,I,A,B,D) A
2173 #define PLOGICAL_cfT(M,I,A,B,D) ((*A=F2CLOGICAL(*A)),A)
2174 #define PLONG_cfT(M,I,A,B,D) A
2175 #define PLONGLONG_cfT(M,I,A,B,D) A /* added by MR December 2005 */
2176 #define PSHORT_cfT(M,I,A,B,D) A
2177 #define PVOID_cfT(M,I,A,B,D) A
2178 #if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran)
2179 #define ROUTINE_cfT(M,I,A,B,D) _(ROUTINE_,I) (*A)
2180 #else
2181 #define ROUTINE_cfT(M,I,A,B,D) _(ROUTINE_,I) A
2182 #endif
2183 /* A == pointer to the characters
2184  D == length of the string, or of an element in an array of strings
2185  E == number of elements in an array of strings */
2186 #define TTSTR( A,B,D) \
2187  ((B=_cf_malloc(D+1))[D]='\0', memcpy(B,A,D), kill_trailing(B,' '))
2188 #define TTTTSTR( A,B,D) (!(D<4||A[0]||A[1]||A[2]||A[3]))?NULL: \
2189  memchr(A,'\0',D) ?A : TTSTR(A,B,D)
2190 #define TTTTSTRV( A,B,D,E) (_(B,N)=E,B=_cf_malloc(_(B,N)*(D+1)), (void *) \
2191  vkill_trailing(f2cstrv(A,B,D+1, _(B,N)*(D+1)), D+1,_(B,N)*(D+1),' '))
2192 #ifdef vmsFortran
2193 #define STRING_cfT(M,I,A,B,D) TTTTSTR( A->dsc$a_pointer,B,A->dsc$w_length)
2194 #define STRINGV_cfT(M,I,A,B,D) TTTTSTRV(A->dsc$a_pointer, B, \
2195  A->dsc$w_length , A->dsc$l_m[0])
2196 #define PSTRING_cfT(M,I,A,B,D) TTSTR( A->dsc$a_pointer,B,A->dsc$w_length)
2197 #define PPSTRING_cfT(M,I,A,B,D) A->dsc$a_pointer
2198 #else
2199 #ifdef CRAYFortran
2200 #define STRING_cfT(M,I,A,B,D) TTTTSTR( _fcdtocp(A),B,_fcdlen(A))
2201 #define STRINGV_cfT(M,I,A,B,D) TTTTSTRV(_fcdtocp(A),B,_fcdlen(A), \
2202  num_elem(_fcdtocp(A),_fcdlen(A),_3(M,_STRV_A,I)))
2203 #define PSTRING_cfT(M,I,A,B,D) TTSTR( _fcdtocp(A),B,_fcdlen(A))
2204 #define PPSTRING_cfT(M,I,A,B,D) _fcdtocp(A)
2205 #else
2206 #define STRING_cfT(M,I,A,B,D) TTTTSTR( A,B,D)
2207 #define STRINGV_cfT(M,I,A,B,D) TTTTSTRV(A,B,D, num_elem(A,D,_3(M,_STRV_A,I)))
2208 #define PSTRING_cfT(M,I,A,B,D) TTSTR( A,B,D)
2209 #define PPSTRING_cfT(M,I,A,B,D) A
2210 #endif
2211 #endif
2212 #define PNSTRING_cfT(M,I,A,B,D) STRING_cfT(M,I,A,B,D)
2213 #define PSTRINGV_cfT(M,I,A,B,D) STRINGV_cfT(M,I,A,B,D)
2214 #define CF_0_cfT(M,I,A,B,D)
2215 
2216 #define RCF(TN,I) _(TN,_cfSTR)(3,R,_(A,I),_(B,I),_(C,I),0,0)
2217 #define DEFAULT_cfR(A,B,D)
2218 #define LOGICAL_cfR(A,B,D)
2219 #define PLOGICAL_cfR(A,B,D) *A=C2FLOGICAL(*A);
2220 #define STRING_cfR(A,B,D) if (B) _cf_free(B);
2221 #define STRINGV_cfR(A,B,D) _cf_free(B);
2222 /* A and D as defined above for TSTRING(V) */
2223 #define RRRRPSTR( A,B,D) if (B) memcpy(A,B, _cfMIN(strlen(B),D)), \
2224  (D>strlen(B)?memset(A+strlen(B),' ', D-strlen(B)):0), _cf_free(B);
2225 #define RRRRPSTRV(A,B,D) c2fstrv(B,A,D+1,(D+1)*_(B,N)), _cf_free(B);
2226 #ifdef vmsFortran
2227 #define PSTRING_cfR(A,B,D) RRRRPSTR( A->dsc$a_pointer,B,A->dsc$w_length)
2228 #define PSTRINGV_cfR(A,B,D) RRRRPSTRV(A->dsc$a_pointer,B,A->dsc$w_length)
2229 #else
2230 #ifdef CRAYFortran
2231 #define PSTRING_cfR(A,B,D) RRRRPSTR( _fcdtocp(A),B,_fcdlen(A))
2232 #define PSTRINGV_cfR(A,B,D) RRRRPSTRV(_fcdtocp(A),B,_fcdlen(A))
2233 #else
2234 #define PSTRING_cfR(A,B,D) RRRRPSTR( A,B,D)
2235 #define PSTRINGV_cfR(A,B,D) RRRRPSTRV(A,B,D)
2236 #endif
2237 #endif
2238 #define PNSTRING_cfR(A,B,D) PSTRING_cfR(A,B,D)
2239 #define PPSTRING_cfR(A,B,D)
2240 
2241 #define BYTE_cfFZ(UN,LN) INTEGER_BYTE FCALLSC_QUALIFIER fcallsc(UN,LN)(
2242 #define DOUBLE_cfFZ(UN,LN) OOMPH_DOUBLE_PRECISION FCALLSC_QUALIFIER fcallsc(UN,LN)(
2243 #define INT_cfFZ(UN,LN) int FCALLSC_QUALIFIER fcallsc(UN,LN)(
2244 #define LOGICAL_cfFZ(UN,LN) int FCALLSC_QUALIFIER fcallsc(UN,LN)(
2245 #define LONG_cfFZ(UN,LN) long FCALLSC_QUALIFIER fcallsc(UN,LN)(
2246 #define LONGLONG_cfFZ(UN,LN) LONGLONG FCALLSC_QUALIFIER fcallsc(UN,LN)( /* added by MR December 2005 */
2247 #define SHORT_cfFZ(UN,LN) short FCALLSC_QUALIFIER fcallsc(UN,LN)(
2248 #define VOID_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(
2249 #ifndef __CF__KnR
2250 /* The void is req'd by the Apollo, to make this an ANSI function declaration.
2251  The Apollo promotes K&R float functions to double. */
2252 #if defined (f2cFortran) && ! defined (gFortran)
2253 /* f2c/g77 return double from FORTRAN REAL functions. (KMCCARTY, 2005/12/09) */
2254 #define FLOAT_cfFZ(UN,LN) OOMPH_DOUBLE_PRECISION FCALLSC_QUALIFIER fcallsc(UN,LN)(void
2255 #else
2256 #define FLOAT_cfFZ(UN,LN) FORTRAN_REAL FCALLSC_QUALIFIER fcallsc(UN,LN)(void
2257 #endif
2258 #ifdef vmsFortran
2259 #define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(fstring *AS
2260 #else
2261 #ifdef CRAYFortran
2262 #define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(_fcd AS
2263 #else
2264 #if defined(AbsoftUNIXFortran) || defined(AbsoftProFortran)
2265 #define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(char *AS
2266 #else
2267 #define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(char *AS, unsigned D0
2268 #endif
2269 #endif
2270 #endif
2271 #else
2272 #if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT))
2273 #if defined (f2cFortran) && ! defined (gFortran)
2274 /* f2c/g77 return double from FORTRAN REAL functions. (KMCCARTY, 2005/12/09) */
2275 #define FLOAT_cfFZ(UN,LN) OOMPH_DOUBLE_PRECISION FCALLSC_QUALIFIER fcallsc(UN,LN)(
2276 #else
2277 #define FLOAT_cfFZ(UN,LN) FORTRAN_REAL FCALLSC_QUALIFIER fcallsc(UN,LN)(
2278 #endif
2279 #else
2280 #define FLOAT_cfFZ(UN,LN) FLOATFUNCTIONTYPE FCALLSC_QUALIFIER fcallsc(UN,LN)(
2281 #endif
2282 #if defined(vmsFortran) || defined(CRAYFortran) || defined(AbsoftUNIXFortran)
2283 #define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(AS
2284 #else
2285 #define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(AS, D0
2286 #endif
2287 #endif
2288 
2289 #define BYTE_cfF(UN,LN) BYTE_cfFZ(UN,LN)
2290 #define DOUBLE_cfF(UN,LN) DOUBLE_cfFZ(UN,LN)
2291 #ifndef __CF_KnR
2292 #if defined (f2cFortran) && ! defined (gFortran)
2293 /* f2c/g77 return double from FORTRAN REAL functions. (KMCCARTY, 2005/12/09) */
2294 #define FLOAT_cfF(UN,LN) OOMPH_DOUBLE_PRECISION FCALLSC_QUALIFIER fcallsc(UN,LN)(
2295 #else
2296 #define FLOAT_cfF(UN,LN) FORTRAN_REAL FCALLSC_QUALIFIER fcallsc(UN,LN)(
2297 #endif
2298 #else
2299 #define FLOAT_cfF(UN,LN) FLOAT_cfFZ(UN,LN)
2300 #endif
2301 #define INT_cfF(UN,LN) INT_cfFZ(UN,LN)
2302 #define LOGICAL_cfF(UN,LN) LOGICAL_cfFZ(UN,LN)
2303 #define LONG_cfF(UN,LN) LONG_cfFZ(UN,LN)
2304 #define LONGLONG_cfF(UN,LN) LONGLONG_cfFZ(UN,LN) /* added by MR December 2005 */
2305 #define SHORT_cfF(UN,LN) SHORT_cfFZ(UN,LN)
2306 #define VOID_cfF(UN,LN) VOID_cfFZ(UN,LN)
2307 #define STRING_cfF(UN,LN) STRING_cfFZ(UN,LN),
2308 
2309 #define INT_cfFF
2310 #define VOID_cfFF
2311 #ifdef vmsFortran
2312 #define STRING_cfFF fstring *AS;
2313 #else
2314 #ifdef CRAYFortran
2315 #define STRING_cfFF _fcd AS;
2316 #else
2317 #define STRING_cfFF char *AS; unsigned D0;
2318 #endif
2319 #endif
2320 
2321 #define INT_cfL A0=
2322 #define STRING_cfL A0=
2323 #define VOID_cfL
2324 
2325 #define INT_cfK
2326 #define VOID_cfK
2327 /* KSTRING copies the string into the position provided by the caller. */
2328 #ifdef vmsFortran
2329 #define STRING_cfK \
2330  memcpy(AS->dsc$a_pointer,A0,_cfMIN(AS->dsc$w_length,(A0==NULL?0:strlen(A0))));\
2331  AS->dsc$w_length>(A0==NULL?0:strlen(A0))? \
2332  memset(AS->dsc$a_pointer+(A0==NULL?0:strlen(A0)),' ', \
2333  AS->dsc$w_length-(A0==NULL?0:strlen(A0))):0;
2334 #else
2335 #ifdef CRAYFortran
2336 #define STRING_cfK \
2337  memcpy(_fcdtocp(AS),A0, _cfMIN(_fcdlen(AS),(A0==NULL?0:strlen(A0))) ); \
2338  _fcdlen(AS)>(A0==NULL?0:strlen(A0))? \
2339  memset(_fcdtocp(AS)+(A0==NULL?0:strlen(A0)),' ', \
2340  _fcdlen(AS)-(A0==NULL?0:strlen(A0))):0;
2341 #else
2342 #define STRING_cfK memcpy(AS,A0, _cfMIN(D0,(A0==NULL?0:strlen(A0))) ); \
2343  D0>(A0==NULL?0:strlen(A0))?memset(AS+(A0==NULL?0:strlen(A0)), \
2344  ' ', D0-(A0==NULL?0:strlen(A0))):0;
2345 #endif
2346 #endif
2347 
2348 /* Note that K.. and I.. can't be combined since K.. has to access data before
2349 R.., in order for functions returning strings which are also passed in as
2350 arguments to work correctly. Note that R.. frees and hence may corrupt the
2351 string. */
2352 #define BYTE_cfI return A0;
2353 #define DOUBLE_cfI return A0;
2354 #if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT))
2355 #define FLOAT_cfI return A0;
2356 #else
2357 #define FLOAT_cfI RETURNFLOAT(A0);
2358 #endif
2359 #define INT_cfI return A0;
2360 #ifdef hpuxFortran800
2361 /* Incredibly, functions must return true as 1, elsewhere .true.==0x01000000. */
2362 #define LOGICAL_cfI return ((A0)?1:0);
2363 #else
2364 #define LOGICAL_cfI return C2FLOGICAL(A0);
2365 #endif
2366 #define LONG_cfI return A0;
2367 #define LONGLONG_cfI return A0; /* added by MR December 2005 */
2368 #define SHORT_cfI return A0;
2369 #define STRING_cfI return ;
2370 #define VOID_cfI return ;
2371 
2372 #ifdef OLD_VAXC /* Allow %CC-I-PARAMNOTUSED. */
2373 #pragma standard
2374 #endif
2375 
2376 #define FCALLSCSUB0( CN,UN,LN) FCALLSCFUN0(VOID,CN,UN,LN)
2377 #define FCALLSCSUB1( CN,UN,LN,T1) FCALLSCFUN1(VOID,CN,UN,LN,T1)
2378 #define FCALLSCSUB2( CN,UN,LN,T1,T2) FCALLSCFUN2(VOID,CN,UN,LN,T1,T2)
2379 #define FCALLSCSUB3( CN,UN,LN,T1,T2,T3) FCALLSCFUN3(VOID,CN,UN,LN,T1,T2,T3)
2380 #define FCALLSCSUB4( CN,UN,LN,T1,T2,T3,T4) \
2381  FCALLSCFUN4(VOID,CN,UN,LN,T1,T2,T3,T4)
2382 #define FCALLSCSUB5( CN,UN,LN,T1,T2,T3,T4,T5) \
2383  FCALLSCFUN5(VOID,CN,UN,LN,T1,T2,T3,T4,T5)
2384 #define FCALLSCSUB6( CN,UN,LN,T1,T2,T3,T4,T5,T6) \
2385  FCALLSCFUN6(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6)
2386 #define FCALLSCSUB7( CN,UN,LN,T1,T2,T3,T4,T5,T6,T7) \
2387  FCALLSCFUN7(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7)
2388 #define FCALLSCSUB8( CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \
2389  FCALLSCFUN8(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8)
2390 #define FCALLSCSUB9( CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \
2391  FCALLSCFUN9(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9)
2392 #define FCALLSCSUB10(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \
2393  FCALLSCFUN10(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA)
2394 #define FCALLSCSUB11(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \
2395  FCALLSCFUN11(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB)
2396 #define FCALLSCSUB12(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \
2397  FCALLSCFUN12(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC)
2398 #define FCALLSCSUB13(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \
2399  FCALLSCFUN13(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD)
2400 #define FCALLSCSUB14(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
2401  FCALLSCFUN14(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
2402 #define FCALLSCSUB15(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF) \
2403  FCALLSCFUN15(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF)
2404 #define FCALLSCSUB16(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG) \
2405  FCALLSCFUN16(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG)
2406 #define FCALLSCSUB17(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH) \
2407  FCALLSCFUN17(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH)
2408 #define FCALLSCSUB18(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI) \
2409  FCALLSCFUN18(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI)
2410 #define FCALLSCSUB19(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ) \
2411  FCALLSCFUN19(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ)
2412 #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) \
2413  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)
2414 #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) \
2415  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)
2416 #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) \
2417  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)
2418 #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) \
2419  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)
2420 #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) \
2421  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)
2422 #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) \
2423  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)
2424 #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) \
2425  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)
2426 #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) \
2427  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)
2428 
2429 
2430 #define FCALLSCFUN1( T0,CN,UN,LN,T1) \
2431  FCALLSCFUN5 (T0,CN,UN,LN,T1,CF_0,CF_0,CF_0,CF_0)
2432 #define FCALLSCFUN2( T0,CN,UN,LN,T1,T2) \
2433  FCALLSCFUN5 (T0,CN,UN,LN,T1,T2,CF_0,CF_0,CF_0)
2434 #define FCALLSCFUN3( T0,CN,UN,LN,T1,T2,T3) \
2435  FCALLSCFUN5 (T0,CN,UN,LN,T1,T2,T3,CF_0,CF_0)
2436 #define FCALLSCFUN4( T0,CN,UN,LN,T1,T2,T3,T4) \
2437  FCALLSCFUN5 (T0,CN,UN,LN,T1,T2,T3,T4,CF_0)
2438 #define FCALLSCFUN5( T0,CN,UN,LN,T1,T2,T3,T4,T5) \
2439  FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0)
2440 #define FCALLSCFUN6( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6) \
2441  FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0)
2442 #define FCALLSCFUN7( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7) \
2443  FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0)
2444 #define FCALLSCFUN8( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \
2445  FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0)
2446 #define FCALLSCFUN9( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \
2447  FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0)
2448 #define FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \
2449  FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0)
2450 #define FCALLSCFUN11(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \
2451  FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0)
2452 #define FCALLSCFUN12(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \
2453  FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0)
2454 #define FCALLSCFUN13(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \
2455  FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0)
2456 
2457 
2458 #define FCALLSCFUN15(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF) \
2459  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)
2460 #define FCALLSCFUN16(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG) \
2461  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)
2462 #define FCALLSCFUN17(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH) \
2463  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)
2464 #define FCALLSCFUN18(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI) \
2465  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)
2466 #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) \
2467  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)
2468 #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) \
2469  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)
2470 #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) \
2471  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)
2472 #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) \
2473  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)
2474 #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) \
2475  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)
2476 #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) \
2477  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)
2478 #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) \
2479  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)
2480 #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) \
2481  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)
2482 
2483 
2484 #ifndef __CF__KnR
2485 #define FCALLSCFUN0(T0,CN,UN,LN) CFextern _(T0,_cfFZ)(UN,LN) ABSOFT_cf2(T0)) \
2486  {_Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN(); _Icf(0,K,T0,0,0) _(T0,_cfI)}
2487 
2488 #define FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
2489  CFextern _(T0,_cfF)(UN,LN) \
2490  CFARGT14(NCF,DCF,ABSOFT_cf2(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) ) \
2491  { CFARGT14S(QCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
2492  _Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN( TCF(LN,T1,1,0) TCF(LN,T2,2,1) \
2493  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) \
2494  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) \
2495  TCF(LN,TD,13,1) TCF(LN,TE,14,1) ); _Icf(0,K,T0,0,0) \
2496  CFARGT14S(RCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) _(T0,_cfI) }
2497 
2498 #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) \
2499  CFextern _(T0,_cfF)(UN,LN) \
2500  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) ) \
2501  { 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) \
2502  _Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN( TCF(LN,T1,1,0) TCF(LN,T2,2,1) \
2503  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) \
2504  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) \
2505  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) \
2506  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) \
2507  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) \
2508  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) }
2509 
2510 #else
2511 #define FCALLSCFUN0(T0,CN,UN,LN) CFextern _(T0,_cfFZ)(UN,LN) ABSOFT_cf3(T0)) _Icf(0,FF,T0,0,0)\
2512  {_Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN(); _Icf(0,K,T0,0,0) _(T0,_cfI)}
2513 
2514 #define FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
2515  CFextern _(T0,_cfF)(UN,LN) \
2516  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) \
2517  CFARGT14FS(NNNCF,DDDCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE); \
2518  { CFARGT14S(QCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
2519  _Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN( TCF(LN,T1,1,0) TCF(LN,T2,2,1) \
2520  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) \
2521  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) \
2522  TCF(LN,TD,13,1) TCF(LN,TE,14,1) ); _Icf(0,K,T0,0,0) \
2523  CFARGT14S(RCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) _(T0,_cfI)}
2524 
2525 #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) \
2526  CFextern _(T0,_cfF)(UN,LN) \
2527  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) \
2528  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); \
2529  { 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) \
2530  _Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN( TCF(LN,T1,1,0) TCF(LN,T2,2,1) \
2531  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) \
2532  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) \
2533  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) \
2534  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) \
2535  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) \
2536  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)}
2537 
2538 #endif
2539 
2540 
2541 #endif /* __CFORTRAN_LOADED */
static char * f2cstrv(char *fstr, char *cstr, int elem_len, int sizeofcstr) static char *f2cstrv(fstr
cstr elem_len * i
Definition: cfortran.h:607
int num_term
Definition: cfortran.h:646
char t
Definition: cfortran.h:572
__int64 LONGLONG
Definition: cfortran.h:100
static char elem_len
Definition: cfortran.h:538
static char * vkill_trailing(char *cstr, int elem_len, int sizeofcstr, char t) static char *vkill_trailing(cstr
e
Definition: cfortran.h:575
int sizeofcstr
Definition: cfortran.h:539
static char fstr
Definition: cfortran.h:538
static char * kill_trailingn(char *s, char t, char *e) static char *kill_trailingn(s
static char * kill_trailing(char *s, char t) static char *kill_trailing(s
struct dsc $descriptor_s fstring
Definition: cfortran.h:611
static char t char * s
Definition: cfortran.h:572
static char * c2fstrv(char *cstr, char *fstr, int elem_len, int sizeofcstr) static char *c2fstrv(cstr
static char sizeofcstr char * cstr
Definition: cfortran.h:538
static int num_term char * strv
Definition: cfortran.h:645
static int num_elem(char *strv, unsigned elem_len, int term_char, int num_term) static int num_elem(strv
void(* cfCAST_FUNCTION)(CF_NULL_PROTO)
Definition: cfortran.h:751
static int term_char
Definition: cfortran.h:645
DSC $DESCRIPTOR_A(1) fstringvector
Definition: cfortran.h:628