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