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