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