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