MISR Toolkit  1.5.1
cfortHdf.h
Go to the documentation of this file.
1 /*
2 Copyright (C) 1996 Hughes and Applied Research Corporation
3 
4 Permission to use, modify, and distribute this software and its documentation
5 for any purpose without fee is hereby granted, provided that the above
6 copyright notice appear in all copies and that both that copyright notice and
7 this permission notice appear in supporting documentation.
8 */
9 
10 
11 /* cfortran.h */ /* 2.8 */ /* anonymous ftp: zebra.desy.de */
12 /* Burkhard Burow, burow@vxdesy.cern.ch, University of Toronto, 1993. */
13 /* Feb 2008 Abe Taaheri extensed "fortran to C calls" to 15 argument funcs */
14 
15 #ifndef __CFORTRAN_LOADED
16 #define __CFORTRAN_LOADED
17 
18 /*
19  THIS FILE IS PROPERTY OF BURKHARD BUROW. IF YOU ARE USING THIS FILE YOU
20  SHOULD ALSO HAVE ACCESS TO CFORTRAN.DOC WHICH PROVIDES TERMS FOR USING,
21  MODIFYING, COPYING AND DISTRIBUTING THE CFORTRAN.H PACKAGE.
22 */
23 
24 /* Before using cfortran.h on CRAY, RS/6000, Apollo >=6.8, gcc -ansi,
25  or any other ANSI C compiler, you must once do:
26 prompt> mv cfortran.h cf_temp.h && sed 's/\/\*\*\//\#\#/g' cf_temp.h >cfortran.h
27  i.e. we change the ' / * * / ' kludge to # #. */
28 
29 /* First prepare for the C compiler. */
30 
31 #if (defined(vax)&&defined(unix)) || (defined(__vax__)&&defined(__unix__))
32 #define VAXUltrix
33 #endif
34 
35 #include <stdio.h> /* NULL [in all machines stdio.h] */
36 #include <string.h> /* strlen, memset, memcpy, memchr. */
37 #if !( defined(VAXUltrix) || defined(sun) || (defined(apollo)&&!defined(__STDCPP__)) )
38 #include <stdlib.h> /* malloc,free */
39 #else
40 #include <malloc.h>
41 #ifdef apollo
42 #define __CF__APOLLO67 /* __STDCPP__ is in Apollo 6.8 (i.e. ANSI) and onwards */
43 #endif
44 #endif
45 
46 #if (!defined(__GNUC__) && (defined(sun)||defined(VAXUltrix)||defined(lynx)))
47 #define __CF__KnR /* Sun, LynxOS and VAX Ultrix cc only supports K&R. */
48  /* Manually define __CF__KnR for HP if desired/required.*/
49 #endif /* i.e. We will generate Kernighan and Ritchie C. */
50 /* Note that you may define __CF__KnR before #include cfortran.h, in order to
51 generate K&R C instead of the default ANSI C. The differences are mainly in the
52 function prototypes and declarations. All machines, except the Apollo, work
53 with either style. The Apollo's argument promotion rules require ANSI or use of
54 the obsolete std_$call which we have not implemented here. Hence on the Apollo,
55 only C calling FORTRAN subroutines will work using K&R style.*/
56 
57 
58 /* Remainder of cfortran.h depends on the Fortran compiler. */
59 
60 /* VAX/VMS does not let us \-split these long lines. */
61 #if !(defined(NAGf90Fortran)||defined(f2cFortran)||defined(hpuxFortran)||defined(apolloFortran)||defined(sunFortran)||defined(IBMR2Fortran)||defined(CRAYFortran)||defined(mipsFortran)||defined(DECFortran)||defined(vmsFortran))
62 /* If no Fortran compiler is given, we choose one for the machines we know. */
63 #if defined(lynx) || defined(VAXUltrix)
64 #define f2cFortran /* Lynx: Only support f2c at the moment.
65  VAXUltrix: f77 behaves like f2c.
66  Support f2c or f77 with gcc, vcc with f2c.
67  f77 with vcc works, missing link magic for f77 I/O.*/
68 #endif
69 #if defined(__hpux) /* 921107: Use __hpux instead of __hp9000s300 */
70 #define hpuxFortran /* Should also allow hp9000s7/800 use.*/
71 #endif
72 #if defined(apollo)
73 #define apolloFortran /* __CF__APOLLO67 defines some behavior. */
74 #endif
75 #if defined(sun)
76 #define sunFortran
77 #endif
78 #if defined(_IBMR2)
79 #define IBMR2Fortran
80 #endif
81 #if defined(_CRAY)
82 #define CRAYFortran /* _CRAY2 defines some behavior. */
83 #endif
84 #if defined(mips) || defined(__mips)
85 #define mipsFortran
86 #endif
87 #if defined(vms) || defined(__vms)
88 #define vmsFortran
89 #endif
90 #if defined(__alpha) && defined(__unix__)
91 #define DECFortran
92 #endif
93 #endif /* ...Fortran */
94 
95 
96 
97 #if defined(VAXC) && !defined(__VAXC)
98 #define OLD_VAXC
99 #pragma nostandard /* Prevent %CC-I-PARAMNOTUSED. */
100 #endif
101 
102 /* Throughout cfortran.h we use: UN = Uppercase Name. LN = Lowercase Name. */
103 
104 #if defined(f2cFortran) || defined(NAGf90Fortran) || defined(DECFortran) || defined(mipsFortran) || defined(apolloFortran) || defined(sunFortran) || defined(extname)
105 #if defined(f2cFortran)
106 #define CFC_(UN,LN) LN##_ /* Lowercase FORTRAN symbols. */
107 #else
108 #define CFC_(UN,LN) LN##_ /* Lowercase FORTRAN symbols. */
109 #endif /* f2cFortran */
110 #define orig_fcallsc CFC_
111 #else
112 #ifdef CRAYFortran
113 #define CFC_(UN,LN) UN /* Uppercase FORTRAN symbols. */
114 #define orig_fcallsc(UN,LN) CFC_(UN,LN) /* CRAY insists on arg.'s here. */
115 #else /* For following machines one may wish to change the fcallsc default. */
116 #define CF_SAME_NAMESPACE
117 #ifdef vmsFortran
118 #define CFC_(UN,LN) LN /* Either case FORTRAN symbols. */
119  /* BUT we usually use UN for C macro to FORTRAN routines, so use LN here,*/
120  /* because VAX/VMS doesn't do recursive macros. */
121 #define orig_fcallsc(UN,LN) UN
122 #else /* HP-UX without +ppu or IBMR2 without -qextname. NOT reccomended. */
123 #define CFC_(UN,LN) LN /* Lowercase FORTRAN symbols. */
124 #define orig_fcallsc CFC_
125 #endif /* vmsFortran */
126 #endif /* CRAYFortran */
127 #endif /* ....Fortran */
128 
129 #define fcallsc orig_fcallsc
130 #define preface_fcallsc(P,p,UN,LN) CFC_(P##UN,p##LN)
131 #define append_fcallsc(P,p,UN,LN) CFC_(UN##P,LN##p)
132 
133 #define C_FUNCTION fcallsc
134 #define FORTRAN_FUNCTION CFC_
135 #define COMMON_BLOCK CFC_
136 
137 #if defined(NAGf90Fortran) || defined(f2cFortran) || defined(mipsFortran)
138 #define LOGICAL_STRICT /* These have .eqv./.neqv. == .eq./.ne. */
139 #endif
140 
141 #ifdef CRAYFortran
142 #if _CRAY
143 #include <fortran.h>
144 #else
145 #include "fortran.h" /* i.e. if crosscompiling assume user has file. */
146 #endif
147 #define DOUBLE_PRECISION long double
148 #define PPFLOATVVVVVVV (float *) /* Used for C calls FORTRAN. */
149 /* CRAY's double==float but CRAY says pointers to doubles and floats are diff.*/
150 #define VOIDP0 (void *) /* When FORTRAN calls C, we don't know if C routine
151  arg.'s have been declared float *, or double *. */
152 #else
153 #define DOUBLE_PRECISION double
154 #define PPFLOATVVVVVVV
155 #define VOIDP0
156 #endif
157 
158 #ifdef vmsFortran
159 #if defined(vms) || defined(__vms)
160 #include <descrip.h>
161 #else
162 #include "descrip.h" /* i.e. if crosscompiling assume user has file. */
163 #endif
164 #endif
165 
166 #ifdef sunFortran
167 #if sun
168 #include <math.h> /* Sun's FLOATFUNCTIONTYPE, ASSIGNFLOAT, RETURNFLOAT. */
169 #else
170 #include "math.h" /* i.e. if crosscompiling assume user has file. */
171 #endif
172 #endif
173 
174 #ifdef __cplusplus
175 extern "C" {
176 #endif
177 
178 #ifndef apolloFortran
179 #define COMMON_BLOCK_DEF(DEFINITION, NAME) extern DEFINITION NAME
180 #define CF_NULL_PROTO
181 #else /* HP doesn't understand #elif. */
182 /* Without ANSI prototyping, Apollo promotes float functions to double. */
183 /* Note that VAX/VMS, IBM, Mips choke on 'type function(...);' prototypes. */
184 #define CF_NULL_PROTO ...
185 #ifndef __CF__APOLLO67
186 #define COMMON_BLOCK_DEF(DEFINITION, NAME) \
187  DEFINITION NAME __attribute((__section(NAME)))
188 #else
189 #define COMMON_BLOCK_DEF(DEFINITION, NAME) \
190  DEFINITION NAME #attribute[section(NAME)]
191 #endif
192 #endif
193 
194 #ifdef mipsFortran
195 #define CF_DECLARE_GETARG int f77argc; char **f77argv
196 #define CF_SET_GETARG(ARGC,ARGV) f77argc = ARGC; f77argv = ARGV
197 #else
198 #define CF_DECLARE_GETARG
199 #define CF_SET_GETARG(ARGC,ARGV)
200 #endif
201 
202 #ifdef OLD_VAXC /* Allow %CC-I-PARAMNOTUSED. */
203 #pragma standard
204 #endif
205 
206 #define ACOMMA ,
207 #define ACOLON ;
208 
209 /*-------------------------------------------------------------------------*/
210 
211 /* UTILITIES USED WITHIN CFORTRAN.H */
212 
213 #define PGSMIN(A,B) (A<B?A:B)
214 #define firstindexlength( A) (sizeof(A) /sizeof(A[0]))
215 #define secondindexlength(A) (sizeof((A)[0])/sizeof((A)[0][0]))
216 #ifndef FALSE
217 #define FALSE (1==0)
218 #endif
219 
220 /* Behavior of FORTRAN LOGICAL. All machines' LOGICAL is same size as C's int.
221 Conversion is automatic except for arrays which require F2CLOGICALV/C2FLOGICALV.
222 f2c, MIPS f77 [DECstation, SGI], VAX Ultrix f77, CRAY-2, HP-UX f77: as in C.
223 VAX/VMS FORTRAN, VAX Ultrix fort, IBM RS/6000 xlf: LS Bit = 0/1 = TRUE/FALSE.
224 Apollo, non CRAY-2 : neg. = TRUE, else FALSE.
225 [Apollo accepts -1 as TRUE for function values, but NOT all other neg. values.]
226 [DECFortran for Ultrix RISC is also called f77 but is the same as VAX/VMS.]
227 [MIPS f77 treats .eqv./.neqv. as .eq./.ne. and hence requires LOGICAL_STRICT.]*/
228 
229 #define C2FLOGICALV(A,I) \
230  do {int __i; for(__i=0;__i<I;__i++) A[__i]=C2FLOGICAL(A[__i]); } while (FALSE)
231 #define F2CLOGICALV(A,I) \
232  do {int __i; for(__i=0;__i<I;__i++) A[__i]=F2CLOGICAL(A[__i]); } while (FALSE)
233 
234 #if defined(apolloFortran) || (defined(CRAYFortran) && !defined(_CRAY2))
235 #ifndef apolloFortran
236 #define C2FLOGICAL(L) ((L)?(L)|(1<<sizeof(int)*8-1):(L)&~(1<<sizeof(int)*8-1))
237 #else
238 #define C2FLOGICAL(L) ((L)?-1:(L)&~(1<<sizeof(int)*8-1)) /* Apollo Exception */
239 #endif
240 #define F2CLOGICAL(L) ((L)<0?(L):0)
241 #else
242 #if defined(IBMR2Fortran) || defined(vmsFortran) || defined(DECFortran)
243 #define C2FLOGICAL(L) ((L)?(L)|1:(L)&~(int)1)
244 #define F2CLOGICAL(L) ((L)&1?(L):0)
245 #else /* all other machines evaluate LOGICALs as C does. */
246 #define C2FLOGICAL(L) (L)
247 #define F2CLOGICAL(L) (L)
248 #ifndef LOGICAL_STRICT
249 #undef C2FLOGICALV
250 #undef F2CLOGICALV
251 #define C2FLOGICALV(A,I)
252 #define F2CLOGICALV(A,I)
253 #endif /* LOGICAL_STRICT */
254 #endif
255 #endif
256 
257 #ifdef LOGICAL_STRICT
258 /* Force C2FLOGICAL to generate only the values for either .TRUE. or .FALSE.
259  This is only needed if you want to do:
260  logical lvariable
261  if (lvariable .eq. .true.) then ! (1)
262  instead of
263  if (lvariable .eqv. .true.) then ! (2)
264  - (1) may not even be FORTRAN/77 and that Apollo's f77 and IBM's xlf
265  refuse to compile (1), so you are probably well advised to stay away from
266  (1) and from LOGICAL_STRICT.
267  - You pay a (slight) performance penalty for using LOGICAL_STRICT. */
268 #undef C2FLOGICAL
269 #if defined(apolloFortran) || (defined(CRAYFortran) && !defined(_CRAY2)) || defined(vmsFortran) || defined(DECFortran)
270 #define C2FLOGICAL(L) ((L)?-1:0) /* These machines use -1/0 for .true./.false.*/
271 #else
272 #define C2FLOGICAL(L) ((L)? 1:0) /* All others use +1/0 for .true./.false.*/
273 #endif
274 #endif /* LOGICAL_STRICT */
275 
276 /* Convert a vector of C strings into FORTRAN strings. */
277 #ifndef __CF__KnR
278 static char *c2fstrv(char* cstr, char *fstr, int elem_len, int sizeofcstr)
279 #else
280 static char *c2fstrv( cstr, fstr, elem_len, sizeofcstr)
281  char* cstr; char *fstr; int elem_len; int sizeofcstr;
282 #endif
283 { int i,j;
284 /* elem_len includes \0 for C strings. Fortran strings don't have term. \0.
285  Useful size of string must be the same in both languages. */
286 for (i=0; i<sizeofcstr/elem_len; i++) {
287  for (j=1; j<elem_len && *cstr; j++) *fstr++ = *cstr++;
288  cstr += 1+elem_len-j;
289  for (; j<elem_len; j++) *fstr++ = ' ';
290 } return fstr-sizeofcstr+sizeofcstr/elem_len; }
291 
292 /* Convert a vector of FORTRAN strings into C strings. */
293 #ifndef __CF__KnR
294 static char *f2cstrv(char *fstr, char* cstr, int elem_len, int sizeofcstr)
295 #else
296 static char *f2cstrv( fstr, cstr, elem_len, sizeofcstr)
297  char *fstr; char* cstr; int elem_len; int sizeofcstr;
298 #endif
299 { int i,j;
300 /* elem_len includes \0 for C strings. Fortran strings don't have term. \0.
301  Useful size of string must be the same in both languages. */
302 cstr += sizeofcstr;
303 fstr += sizeofcstr - sizeofcstr/elem_len;
304 for (i=0; i<sizeofcstr/elem_len; i++) {
305  *--cstr = '\0';
306  for (j=1; j<elem_len; j++) *--cstr = *--fstr;
307 } return cstr; }
308 
309 /* kill the trailing char t's in string s. */
310 #ifndef __CF__KnR
311 static char *kill_trailing(char *s, char t)
312 #else
313 static char *kill_trailing( s, t) char *s; char t;
314 #endif
315 {char *e;
316 e = s + strlen(s);
317 if (e>s) { /* Need this to handle NULL string.*/
318  while (e>s && *--e==t); /* Don't follow t's past beginning. */
319  e[*e==t?0:1] = '\0'; /* Handle s[0]=t correctly. */
320 } return s; }
321 
322 /* kill_trailingn(s,t,e) will kill the trailing t's in string s. e normally
323 points to the terminating '\0' of s, but may actually point to anywhere in s.
324 s's new '\0' will be placed at e or earlier in order to remove any trailing t's.
325 If e<s string s is left unchanged. */
326 #ifndef __CF__KnR
327 static char *kill_trailingn(char *s, char t, char *e)
328 #else
329 static char *kill_trailingn( s, t, e) char *s; char t; char *e;
330 #endif
331 {
332 if (e==s) *e = '\0'; /* Kill the string makes sense here.*/
333 else if (e>s) { /* Watch out for neg. length string.*/
334  while (e>s && *--e==t); /* Don't follow t's past beginning. */
335  e[*e==t?0:1] = '\0'; /* Handle s[0]=t correctly. */
336 } return s; }
337 
338 /* Note the following assumes that any element which has t's to be chopped off,
339 does indeed fill the entire element. */
340 #ifndef __CF__KnR
341 static char *vkill_trailing(char* cstr, int elem_len, int sizeofcstr, char t)
342 #else
343 static char *vkill_trailing( cstr, elem_len, sizeofcstr, t)
344  char* cstr; int elem_len; int sizeofcstr; char t;
345 #endif
346 { int i;
347 for (i=0; i<sizeofcstr/elem_len; i++) /* elem_len includes \0 for C strings. */
348  kill_trailingn(cstr+elem_len*i,t,cstr+elem_len*(i+1)-1);
349 return cstr; }
350 
351 #ifdef vmsFortran
352 typedef struct dsc$descriptor_s fstring;
353 #define DSC$DESCRIPTOR_A(DIMCT) \
354 struct { \
355  unsigned short dsc$w_length; unsigned char dsc$b_dtype; \
356  unsigned char dsc$b_class; char *dsc$a_pointer; \
357  char dsc$b_scale; unsigned char dsc$b_digits; \
358  struct { \
359  unsigned : 3; unsigned dsc$v_fl_binscale : 1; \
360  unsigned dsc$v_fl_redim : 1; unsigned dsc$v_fl_column : 1; \
361  unsigned dsc$v_fl_coeff : 1; unsigned dsc$v_fl_bounds : 1; \
362  } dsc$b_aflags; \
363  unsigned char dsc$b_dimct; unsigned long dsc$l_arsize; \
364  char *dsc$a_a0; long dsc$l_m [DIMCT]; \
365  struct { \
366  long dsc$l_l; long dsc$l_u; \
367  } dsc$bounds [DIMCT]; \
368 }
369 typedef DSC$DESCRIPTOR_A(1) fstringvector;
370 /*typedef DSC$DESCRIPTOR_A(2) fstringarrarr;
371  typedef DSC$DESCRIPTOR_A(3) fstringarrarrarr;*/
372 #define initfstr(F,C,ELEMNO,ELEMLEN) \
373 ( (F).dsc$l_arsize= ( (F).dsc$w_length =(ELEMLEN) ) \
374  *( (F).dsc$l_m[0]=(F).dsc$bounds[0].dsc$l_u=(ELEMNO) ), \
375  (F).dsc$a_a0 = ( (F).dsc$a_pointer=(C) ) - (F).dsc$w_length ,(F))
376 
377 #else
378 #define _NUM_ELEMS -1
379 #define _NUM_ELEM_ARG -2
380 #define NUM_ELEMS(A) A,_NUM_ELEMS
381 #define NUM_ELEM_ARG(B) *A##B,_NUM_ELEM_ARG
382 #define TERM_CHARS(A,B) A,B
383 #ifndef __CF__KnR
384 static int num_elem(char *strv, unsigned elem_len, int term_char, int num_term)
385 #else
386 static int num_elem( strv, elem_len, term_char, num_term)
387  char *strv; unsigned elem_len; int term_char; int num_term;
388 #endif
389 /* elem_len is the number of characters in each element of strv, the FORTRAN
390 vector of strings. The last element of the vector must begin with at least
391 num_term term_char characters, so that this routine can determine how
392 many elements are in the vector. */
393 {
394 unsigned num,i;
395 if (num_term == _NUM_ELEMS || num_term == _NUM_ELEM_ARG)
396  return term_char;
397 if (num_term <=0) num_term = elem_len;
398 for (num=0; ; num++) {
399  for (i=0; (int) i<num_term && *strv==(char) term_char; i++,strv++);
400  if ((int) i==num_term) break;
401  else strv += elem_len-i;
402 }
403 return num;
404 }
405 #endif
406 /*-------------------------------------------------------------------------*/
407 
408 /* UTILITIES FOR C TO USE STRINGS IN FORTRAN COMMON BLOCKS */
409 
410 /* C string TO Fortran Common Block STRing. */
411 /* DIM is the number of DIMensions of the array in terms of strings, not
412  characters. e.g. char a[12] has DIM = 0, char a[12][4] has DIM = 1, etc. */
413 #define C2FCBSTR(CSTR,FSTR,DIM) \
414  c2fstrv((char *)CSTR, (char *)FSTR, sizeof(FSTR)/cfelementsof(FSTR,DIM)+1, \
415  sizeof(FSTR)+cfelementsof(FSTR,DIM))
416 
417 /* Fortran Common Block string TO C STRing. */
418 #define FCB2CSTR(FSTR,CSTR,DIM) \
419  vkill_trailing(f2cstrv((char *)FSTR, (char *)CSTR, \
420  sizeof(FSTR)/cfelementsof(FSTR,DIM)+1, \
421  sizeof(FSTR)+cfelementsof(FSTR,DIM)), \
422  sizeof(FSTR)/cfelementsof(FSTR,DIM)+1, \
423  sizeof(FSTR)+cfelementsof(FSTR,DIM), ' ')
424 
425 #define cfDEREFERENCE0
426 #define cfDEREFERENCE1 *
427 #define cfDEREFERENCE2 **
428 #define cfDEREFERENCE3 ***
429 #define cfDEREFERENCE4 ****
430 #define cfDEREFERENCE5 *****
431 #define cfelementsof(A,D) (sizeof(A)/sizeof(cfDEREFERENCE##D(A)))
432 
433 /*-------------------------------------------------------------------------*/
434 
435 /* UTILITIES FOR C TO CALL FORTRAN SUBROUTINES */
436 
437 /* Define lookup tables for how to handle the various types of variables. */
438 
439 #ifdef OLD_VAXC /* Prevent %CC-I-PARAMNOTUSED. */
440 #pragma nostandard
441 #endif
442 
443 static int __cfztringv[30]; /* => 30 == MAX # of arg.'s C can pass to a */
444 #define ZTRINGV_NUM(I) I /* FORTRAN function. */
445 #define ZTRINGV_ARGF(I) __cfztringv[I]
446 #define ZTRINGV_ARGS(I) B##I
447 
448 #define VPPBYTE VPPINT
449 #define VPPDOUBLE VPPINT
450 #define VPPFLOAT VPPINT
451 #define VPPINT( A,B) int B = (int)A; /* For ZSTRINGV_ARGS */
452 #define VPPLOGICAL(A,B) int *B; /* Returning LOGICAL in FUNn and SUBn.*/
453 #define VPPLONG VPPINT
454 #define VPPSHORT VPPINT
455 
456 #define VCF(TN,I) _INT(3,V,TN,A##I,B##I)
457 #define VVCF(TN,AI,BI) _INT(3,V,TN,AI,BI)
458 #define VINT( T,A,B) typeP##T##VVVVVVV B = A;
459 #define VINTV( T,A,B)
460 #define VINTVV( T,A,B)
461 #define VINTVVV( T,A,B)
462 #define VINTVVVV( T,A,B)
463 #define VINTVVVVV( T,A,B)
464 #define VINTVVVVVV( T,A,B)
465 #define VINTVVVVVVV(T,A,B)
466 #define VPINT( T,A,B) VP##T(A,B)
467 #define VPVOID( T,A,B)
468 #ifdef apolloFortran
469 #define VROUTINE( T,A,B) void (*B)() = (void (*)())A;
470 #else
471 #define VROUTINE( T,A,B)
472 #endif
473 #define VSIMPLE( T,A,B)
474 #ifdef vmsFortran
475 #define VSTRING( T,A,B) static struct {fstring f; unsigned clen;} B = \
476  {{0,DSC$K_DTYPE_T,DSC$K_CLASS_S,NULL},0};
477 #define VPSTRING( T,A,B) static fstring B={0,DSC$K_DTYPE_T,DSC$K_CLASS_S,NULL};
478 #define VSTRINGV( T,A,B) static fstringvector B = \
479  {sizeof(A),DSC$K_DTYPE_T,DSC$K_CLASS_A,NULL,0,0,{0,0,1,1,1},1,0,NULL,0,{1,0}};
480 #define VPSTRINGV( T,A,B) static fstringvector B = \
481  {0,DSC$K_DTYPE_T,DSC$K_CLASS_A,NULL,0,0,{0,0,1,1,1},1,0,NULL,0,{1,0}};
482 #else
483 #define VSTRING( T,A,B) struct {unsigned short clen, flen;} B;
484 #define VSTRINGV( T,A,B) struct {char *s, *fs; unsigned flen;} B;
485 #define VPSTRING( T,A,B) int B;
486 #define VPSTRINGV( T,A,B) struct {char *fs; unsigned short sizeofA, flen;} B;
487 #endif
488 #define VZTRINGV VSTRINGV
489 #define VPZTRINGV VPSTRINGV
490 
491 /* Note that the actions of the A table were performed inside the AA table.
492  VAX Ultrix vcc, and HP-UX cc, didn't evaluate arguments to functions left to
493  right, so we had to split the original table into the current robust two. */
494 #define ACF(NAME,TN,AI,I) STR_##TN(4,A,NAME,I,AI,B##I)
495 #define ALOGICAL( M,I,A,B) B=C2FLOGICAL(B);
496 #define APLOGICAL(M,I,A,B) A=C2FLOGICAL(A);
497 #define ASTRING( M,I,A,B) CSTRING(A,B,sizeof(A))
498 #define APSTRING( M,I,A,B) CPSTRING(A,B,sizeof(A))
499 #ifdef vmsFortran
500 #define AATRINGV( M,I,A,B, sA,filA,silA) \
501  initfstr(B,malloc((sA)-(filA)),(filA),(silA)-1), \
502  c2fstrv(A[0],B.dsc$a_pointer,(silA),(sA));
503 #define APATRINGV(M,I,A,B, sA,filA,silA) \
504  initfstr(B,A[0],(filA),(silA)-1),c2fstrv(A[0],A[0],(silA),(sA));
505 #else
506 #define AATRINGV( M,I,A,B, sA,filA,silA) \
507  (B.s=malloc((sA)-(filA)),B.fs=c2fstrv(A[0],B.s,(B.flen=(silA)-1)+1,(sA)));
508 #define APATRINGV(M,I,A,B, sA,filA,silA) \
509  B.fs=c2fstrv(A[0],A[0],(B.flen=(silA)-1)+1,B.sizeofA=(sA));
510 #endif
511 #define ASTRINGV( M,I,A,B) \
512  AATRINGV( M,I,A,B,sizeof(A),firstindexlength(A),secondindexlength(A))
513 #define APSTRINGV(M,I,A,B) \
514  APATRINGV( M,I,A,B,sizeof(A),firstindexlength(A),secondindexlength(A))
515 #define AZTRINGV( M,I,A,B) AATRINGV( M,I,A,B, \
516  (M##_ELEMS_##I)*(( M##_ELEMLEN_##I)+1), \
517  (M##_ELEMS_##I),(M##_ELEMLEN_##I)+1)
518 #define APZTRINGV(M,I,A,B) APATRINGV( M,I,A,B, \
519  (M##_ELEMS_##I)*(( M##_ELEMLEN_##I)+1), \
520  (M##_ELEMS_##I),(M##_ELEMLEN_##I)+1)
521 
522 #define AAPPBYTE( A,B) &A
523 #define AAPPDOUBLE( A,B) &A
524 #define AAPPFLOAT( A,B) PPFLOATVVVVVVV &A
525 #define AAPPINT( A,B) &A
526 #define AAPPLOGICAL(A,B) B= &A /* B used to keep a common W table. */
527 #define AAPPLONG( A,B) &A
528 #define AAPPSHORT( A,B) &A
529 
530 #define AACF(TN,AI,I,C) _SEP_(TN,C,COMMA) _INT(3,AA,TN,AI,B##I)
531 #define AAINT( T,A,B) &B
532 #define AAINTV( T,A,B) PP##T##VVVVVV A
533 #define AAINTVV( T,A,B) PP##T##VVVVV A[0]
534 #define AAINTVVV( T,A,B) PP##T##VVVV A[0][0]
535 #define AAINTVVVV( T,A,B) PP##T##VVV A[0][0][0]
536 #define AAINTVVVVV( T,A,B) PP##T##VV A[0][0][0][0]
537 #define AAINTVVVVVV( T,A,B) PP##T##V A[0][0][0][0][0]
538 #define AAINTVVVVVVV(T,A,B) PP##T A[0][0][0][0][0][0]
539 #define AAPINT( T,A,B) AAP##T(A,B)
540 #define AAPVOID( T,A,B) (void *) A
541 #ifdef apolloFortran
542 #define AAROUTINE( T,A,B) &B
543 #else
544 #define AAROUTINE( T,A,B) (void(*)())A
545 #endif
546 #define AASTRING( T,A,B) CCSTRING(T,A,B)
547 #define AAPSTRING( T,A,B) CCPSTRING(T,A,B)
548 #ifdef vmsFortran
549 #define AASTRINGV( T,A,B) &B
550 #else
551 #ifdef CRAYFortran
552 #define AASTRINGV( T,A,B) _cptofcd(B.fs,B.flen)
553 #else
554 #define AASTRINGV( T,A,B) B.fs
555 #endif
556 #endif
557 #define AAPSTRINGV AASTRINGV
558 #define AAZTRINGV AASTRINGV
559 #define AAPZTRINGV AASTRINGV
560 
561 #if defined(vmsFortran) || defined(CRAYFortran)
562 #define JCF(TN,I)
563 #else
564 #define JCF(TN,I) STR_##TN(1,J,B##I, 0,0,0)
565 #define JLOGICAL( B)
566 #define JPLOGICAL(B)
567 #define JSTRING( B) ,B.flen
568 #define JPSTRING( B) ,B
569 #define JSTRINGV JSTRING
570 #define JPSTRINGV JSTRING
571 #define JZTRINGV JSTRING
572 #define JPZTRINGV JSTRING
573 #endif
574 
575 #define WCF(TN,AN,I) STR_##TN(2,W,AN,B##I, 0,0)
576 #define WLOGICAL( A,B)
577 #define WPLOGICAL(A,B) *B=F2CLOGICAL(*B);
578 #define WSTRING( A,B) (A[B.clen]!='\0'?A[B.clen]='\0':0); /* A?="constnt"*/
579 #define WPSTRING( A,B) kill_trailing(A,' ');
580 #ifdef vmsFortran
581 #define WSTRINGV( A,B) free(B.dsc$a_pointer);
582 #define WPSTRINGV(A,B) \
583  vkill_trailing(f2cstrv((char*)A, (char*)A, \
584  B.dsc$w_length+1, B.dsc$l_arsize+B.dsc$l_m[0]), \
585  B.dsc$w_length+1, B.dsc$l_arsize+B.dsc$l_m[0], ' ');
586 #else
587 #define WSTRINGV( A,B) free(B.s);
588 #define WPSTRINGV(A,B) vkill_trailing( \
589  f2cstrv((char*)A,(char*)A,B.flen+1,B.sizeofA), B.flen+1,B.sizeofA,' ');
590 #endif
591 #define WZTRINGV WSTRINGV
592 #define WPZTRINGV WPSTRINGV
593 
594 #define NCF(TN,I,C) _SEP_(TN,C,COMMA) _INT(2,N,TN,A##I,0)
595 #define NNCF UUCF
596 #define NNNCF(TN,I,C) _SEP_(TN,C,COLON) _INT(2,N,TN,A##I,0)
597 #define NINT( T,A) typeP##T##VVVVVVV * A
598 #define NINTV( T,A) typeP##T##VVVVVV * A
599 #define NINTVV( T,A) typeP##T##VVVVV * A
600 #define NINTVVV( T,A) typeP##T##VVVV * A
601 #define NINTVVVV( T,A) typeP##T##VVV * A
602 #define NINTVVVVV( T,A) typeP##T##VV * A
603 #define NINTVVVVVV( T,A) typeP##T##V * A
604 #define NINTVVVVVVV(T,A) typeP##T * A
605 #define NPINT( T,A) type##T##VVVVVVV * A
606 #define NPVOID( T,A) void * A
607 #ifdef apolloFortran
608 #define NROUTINE( T,A) void (**A)()
609 #else
610 #define NROUTINE( T,A) void ( *A)()
611 #endif
612 #ifdef vmsFortran
613 #define NSTRING( T,A) fstring * A
614 #define NSTRINGV( T,A) fstringvector * A
615 #else
616 #ifdef CRAYFortran
617 #define NSTRING( T,A) _fcd A
618 #define NSTRINGV( T,A) _fcd A
619 #else
620 #define NSTRING( T,A) char * A
621 #define NSTRINGV( T,A) char * A
622 #endif
623 #endif
624 #define NPSTRING( T,A) NSTRING(T,A) /* CRAY insists on arg.'s here. */
625 #define NPNSTRING( T,A) NSTRING(T,A) /* CRAY insists on arg.'s here. */
626 #define NPPSTRING( T,A) NSTRING(T,A) /* CRAY insists on arg.'s here. */
627 #define NSTRVOID( T,A) NSTRING(T,A) /* CRAY insists on arg.'s here. */
628 #define NPSTRINGV( T,A) NSTRINGV(T,A)
629 #define NZTRINGV( T,A) NSTRINGV(T,A)
630 #define NPZTRINGV( T,A) NPSTRINGV(T,A)
631 
632 /* Note: Prevent compiler warnings, null #define PROTOCCALLSFSUB14/20 after
633  #include-ing cfortran.h if calling the FORTRAN wrapper within the same
634  source code where the wrapper is created. */
635 #ifndef __CF__KnR
636 #define PROTOCCALLSFSUB0(UN,LN) extern void CFC_(UN,LN)();
637 #define PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
638  extern void CFC_(UN,LN)(NCF(T1,1,0) NCF(T2,2,1) NCF(T3,3,1) NCF(T4,4,1) \
639  NCF(T5,5,1) NCF(T6,6,1) NCF(T7,7,1) NCF(T8,8,1) NCF(T9,9,1) NCF(TA,A,1) \
640  NCF(TB,B,1) NCF(TC,C,1) NCF(TD,D,1) NCF(TE,E,1) ,...);
641 #define PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)\
642  extern void CFC_(UN,LN)(NCF(T1,1,0) NCF(T2,2,1) NCF(T3,3,1) NCF(T4,4,1) \
643  NCF(T5,5,1) NCF(T6,6,1) NCF(T7,7,1) NCF(T8,8,1) NCF(T9,9,1) NCF(TA,A,1) \
644  NCF(TB,B,1) NCF(TC,C,1) NCF(TD,D,1) NCF(TE,E,1) NCF(TF,F,1) NCF(TG,G,1) \
645  NCF(TH,H,1) NCF(TI,I,1) NCF(TJ,J,1) NCF(TK,K,1) ,...);
646 #else
647 #define PROTOCCALLSFSUB0( UN,LN)
648 #define PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
649 #define PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)
650 #endif
651 
652 #ifdef OLD_VAXC /* Allow %CC-I-PARAMNOTUSED. */
653 #pragma standard
654 #endif
655 
656 /* do{...}while(FALSE) allows if(a==b) FORT(); else BORT(); */
657 
658 #define CCALLSFSUB0(UN,LN) \
659  do{PROTOCCALLSFSUB0(UN,LN) CFC_(UN,LN)();}while(FALSE)
660 
661 #define CCALLSFSUB1( UN,LN,T1, A1) \
662  CCALLSFSUB5 (UN,LN,T1,CF_0,CF_0,CF_0,CF_0,A1,0,0,0,0)
663 #define CCALLSFSUB2( UN,LN,T1,T2, A1,A2) \
664  CCALLSFSUB5 (UN,LN,T1,T2,CF_0,CF_0,CF_0,A1,A2,0,0,0)
665 #define CCALLSFSUB3( UN,LN,T1,T2,T3, A1,A2,A3) \
666  CCALLSFSUB5 (UN,LN,T1,T2,T3,CF_0,CF_0,A1,A2,A3,0,0)
667 #define CCALLSFSUB4( UN,LN,T1,T2,T3,T4, A1,A2,A3,A4)\
668  CCALLSFSUB5 (UN,LN,T1,T2,T3,T4,CF_0,A1,A2,A3,A4,0)
669 #define CCALLSFSUB5( UN,LN,T1,T2,T3,T4,T5, A1,A2,A3,A4,A5) \
670  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)
671 #define CCALLSFSUB6( UN,LN,T1,T2,T3,T4,T5,T6, A1,A2,A3,A4,A5,A6) \
672  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)
673 #define CCALLSFSUB7( UN,LN,T1,T2,T3,T4,T5,T6,T7, A1,A2,A3,A4,A5,A6,A7) \
674  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)
675 #define CCALLSFSUB8( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8, A1,A2,A3,A4,A5,A6,A7,A8) \
676  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)
677 #define CCALLSFSUB9( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,A1,A2,A3,A4,A5,A6,A7,A8,A9)\
678  CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,0)
679 #define CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA)\
680  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)
681 #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)\
682  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)
683 #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)\
684  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)
685 #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)\
686  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)
687 
688 #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)\
689 do{VVCF(T1,A1,B1) VVCF(T2,A2,B2) VVCF(T3,A3,B3) VVCF(T4,A4,B4) VVCF(T5,A5,B5) \
690  VVCF(T6,A6,B6) VVCF(T7,A7,B7) VVCF(T8,A8,B8) VVCF(T9,A9,B9) VVCF(TA,AA,BA) \
691  VVCF(TB,AB,BB) VVCF(TC,AC,BC) VVCF(TD,AD,BD) VVCF(TE,AE,BE) \
692  PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
693  ACF(LN,T1,A1,1) ACF(LN,T2,A2,2) ACF(LN,T3,A3,3) \
694  ACF(LN,T4,A4,4) ACF(LN,T5,A5,5) ACF(LN,T6,A6,6) ACF(LN,T7,A7,7) \
695  ACF(LN,T8,A8,8) ACF(LN,T9,A9,9) ACF(LN,TA,AA,A) ACF(LN,TB,AB,B) \
696  ACF(LN,TC,AC,C) ACF(LN,TD,AD,D) ACF(LN,TE,AE,E) \
697  CFC_(UN,LN)(AACF(T1,A1,1,0) AACF(T2,A2,2,1) AACF(T3,A3,3,1) \
698  AACF(T4,A4,4,1) AACF(T5,A5,5,1) AACF(T6,A6,6,1) AACF(T7,A7,7,1) \
699  AACF(T8,A8,8,1) AACF(T9,A9,9,1) AACF(TA,AA,A,1) AACF(TB,AB,B,1) \
700  AACF(TC,AC,C,1) AACF(TD,AD,D,1) AACF(TE,AE,E,1) \
701  JCF(T1,1) JCF(T2,2) JCF(T3,3) JCF(T4,4) JCF(T5,5) JCF(T6,6) JCF(T7,7) \
702  JCF(T8,8) JCF(T9,9) JCF(TA,A) JCF(TB,B) JCF(TC,C) JCF(TD,D) JCF(TE,E) );\
703  WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) \
704  WCF(T6,A6,6) WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,AA,A) \
705  WCF(TB,AB,B) WCF(TC,AC,C) WCF(TD,AD,D) WCF(TE,AE,E) }while(FALSE)
706 
707 /* Apollo 6.7, CRAY, Sun, VAX/Ultrix vcc/cc and HP can't hack more than 31 arg's */
708 #if !(defined(VAXUltrix)&&!defined(__GNUC__)) && !defined(__CF__APOLLO67) && !defined(sun) && !defined(__hpux) && !defined(_CRAY)
709 #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)\
710  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)
711 #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)\
712  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)
713 #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)\
714  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)
715 #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)\
716  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)
717 #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)\
718  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)
719 
720 /* PROTOCCALLSFSUB20 is commented out, because it chokes the VAX VMS compiler.
721  It isn't required since we so far only pass pointers and integers to
722  FORTRAN routines and these arg.'s aren't promoted to anything else. */
723 
724 #define CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH, \
725  TI,TJ,TK, A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) \
726 do{VVCF(T1,A1,B1) VVCF(T2,A2,B2) VVCF(T3,A3,B3) VVCF(T4,A4,B4) VVCF(T5,A5,B5) \
727  VVCF(T6,A6,B6) VVCF(T7,A7,B7) VVCF(T8,A8,B8) VVCF(T9,A9,B9) VVCF(TA,AA,BA) \
728  VVCF(TB,AB,BB) VVCF(TC,AC,BC) VVCF(TD,AD,BD) VVCF(TE,AE,BE) VVCF(TF,AF,BF) \
729  VVCF(TG,AG,BG) VVCF(TH,AH,BH) VVCF(TI,AI,BI) VVCF(TJ,AJ,BJ) VVCF(TK,AK,BK) \
730 /* PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)*/\
731  ACF(LN,T1,A1,1) ACF(LN,T2,A2,2) ACF(LN,T3,A3,3) ACF(LN,T4,A4,4) \
732  ACF(LN,T5,A5,5) ACF(LN,T6,A6,6) ACF(LN,T7,A7,7) ACF(LN,T8,A8,8) \
733  ACF(LN,T9,A9,9) ACF(LN,TA,AA,A) ACF(LN,TB,AB,B) ACF(LN,TC,AC,C) \
734  ACF(LN,TD,AD,D) ACF(LN,TE,AE,E) ACF(LN,TF,AF,F) ACF(LN,TG,AG,G) \
735  ACF(LN,TH,AH,H) ACF(LN,TI,AI,I) ACF(LN,TJ,AJ,J) ACF(LN,TK,AK,K) \
736  CFC_(UN,LN)(AACF(T1,A1,1,0) AACF(T2,A2,2,1) AACF(T3,A3,3,1) AACF(T4,A4,4,1) \
737  AACF(T5,A5,5,1) AACF(T6,A6,6,1) AACF(T7,A7,7,1) AACF(T8,A8,8,1) \
738  AACF(T9,A9,9,1) AACF(TA,AA,A,1) AACF(TB,AB,B,1) AACF(TC,AC,C,1) \
739  AACF(TD,AD,D,1) AACF(TE,AE,E,1) AACF(TF,AF,F,1) AACF(TG,AG,G,1) \
740  AACF(TH,AH,H,1) AACF(TI,AI,I,1) AACF(TJ,AJ,J,1) AACF(TK,AK,K,1) \
741  JCF(T1,1) JCF(T2,2) JCF(T3,3) JCF(T4,4) JCF(T5,5) JCF(T6,6) JCF(T7,7) \
742  JCF(T8,8) JCF(T9,9) JCF(TA,A) JCF(TB,B) JCF(TC,C) JCF(TD,D) JCF(TE,E) \
743  JCF(TF,F) JCF(TG,G) JCF(TH,H) JCF(TI,I) JCF(TJ,J) JCF(TK,K) ); \
744  WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) WCF(T6,A6,6) \
745  WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,AA,A) WCF(TB,AB,B) WCF(TC,AC,C) \
746  WCF(TD,AD,D) WCF(TE,AE,E) WCF(TF,AF,F) WCF(TG,AG,G) WCF(TH,AH,H) WCF(TI,AI,I) \
747  WCF(TJ,AJ,J) WCF(TK,AK,K) }while(FALSE)
748 #endif /* Apollo 6.7, CRAY, Sun and HP can't hack more than 31 arg.'s */
749 
750 /*-------------------------------------------------------------------------*/
751 
752 /* UTILITIES FOR C TO CALL FORTRAN FUNCTIONS */
753 
754 /*N.B. PROTOCCALLSFFUNn(..) generates code, whether or not the FORTRAN
755  function is called. Therefore, especially for creator's of C header files
756  for large FORTRAN libraries which include many functions, to reduce
757  compile time and object code size, it may be desirable to create
758  preprocessor directives to allow users to create code for only those
759  functions which they use. */
760 
761 /* The following defines the maximum length string that a function can return.
762  Of course it may be undefine-d and re-define-d before individual
763  PROTOCCALLSFFUNn(..) as required. It would also be nice to have this derived
764  from the individual machines' limits. */
765 #define MAX_LEN_FORTRAN_FUNCTION_STRING 0x4FE
766 
767 /* The following defines a character used by CFORTRAN.H to flag the end of a
768  string coming out of a FORTRAN routine. */
769 #define CFORTRAN_NON_CHAR 0x7F
770 
771 #ifdef OLD_VAXC /* Prevent %CC-I-PARAMNOTUSED. */
772 #pragma nostandard
773 #endif
774 
775 #define _SEP_(TN,C,COMMA) __SEP_##C(TN,COMMA)
776 #define __SEP_0(TN,COMMA)
777 #define __SEP_1(TN,COMMA) _INT(2,SEP_,TN,COMMA,0)
778 #define SEP_INT(T,B) A##B
779 #define SEP_INTV SEP_INT
780 #define SEP_INTVV SEP_INT
781 #define SEP_INTVVV SEP_INT
782 #define SEP_INTVVVV SEP_INT
783 #define SEP_INTVVVVV SEP_INT
784 #define SEP_INTVVVVVV SEP_INT
785 #define SEP_INTVVVVVVV SEP_INT
786 #define SEP_PINT SEP_INT
787 #define SEP_PVOID SEP_INT
788 #define SEP_ROUTINE SEP_INT
789 #define SEP_SIMPLE SEP_INT
790 #define SEP_VOID SEP_INT /* Need for FORTRAN calls to C subroutines. */
791 #define SEP_STRING SEP_INT
792 #define SEP_STRINGV SEP_INT
793 #define SEP_PSTRING SEP_INT
794 #define SEP_PSTRINGV SEP_INT
795 #define SEP_PNSTRING SEP_INT
796 #define SEP_PPSTRING SEP_INT
797 #define SEP_STRVOID SEP_INT
798 #define SEP_ZTRINGV SEP_INT
799 #define SEP_PZTRINGV SEP_INT
800 
801 #if defined(SIGNED_BYTE) || !defined(UNSIGNED_BYTE)
802 #ifdef OLD_VAXC
803 #define INTEGER_BYTE char /* Old VAXC barfs on 'signed char' */
804 #else
805 #define INTEGER_BYTE signed char /* default */
806 #endif
807 #else
808 #define INTEGER_BYTE unsigned char
809 #endif
810 #define typePBYTEVVVVVVV INTEGER_BYTE
811 #define typePDOUBLEVVVVVVV DOUBLE_PRECISION
812 #define typePFLOATVVVVVVV float
813 #define typePINTVVVVVVV int
814 #define typePLOGICALVVVVVVV int
815 #define typePLONGVVVVVVV long
816 #define typePSHORTVVVVVVV short
817 
818 #define CFARGS0(A,T,W,X,Y,Z) A##T
819 #define CFARGS1(A,T,W,X,Y,Z) A##T(W)
820 #define CFARGS2(A,T,W,X,Y,Z) A##T(W,X)
821 #define CFARGS3(A,T,W,X,Y,Z) A##T(W,X,Y)
822 #define CFARGS4(A,T,W,X,Y,Z) A##T(W,X,Y,Z)
823 
824 #define _INT(N,T,I,Y,Z) INT_##I(N,T,I,Y,Z)
825 #define INT_BYTE INT_DOUBLE
826 #define INT_DOUBLE( N,A,B,Y,Z) CFARGS##N(A,INT,B,Y,Z,0)
827 #define INT_FLOAT INT_DOUBLE
828 #define INT_INT INT_DOUBLE
829 #define INT_LOGICAL INT_DOUBLE
830 #define INT_LONG INT_DOUBLE
831 #define INT_SHORT INT_DOUBLE
832 #define INT_PBYTE INT_PDOUBLE
833 #define INT_PDOUBLE( N,A,B,Y,Z) CFARGS##N(A,PINT,B,Y,Z,0)
834 #define INT_PFLOAT INT_PDOUBLE
835 #define INT_PINT INT_PDOUBLE
836 #define INT_PLOGICAL INT_PDOUBLE
837 #define INT_PLONG INT_PDOUBLE
838 #define INT_PSHORT INT_PDOUBLE
839 #define INT_BYTEV INT_DOUBLEV
840 #define INT_BYTEVV INT_DOUBLEVV
841 #define INT_BYTEVVV INT_DOUBLEVVV
842 #define INT_BYTEVVVV INT_DOUBLEVVVV
843 #define INT_BYTEVVVVV INT_DOUBLEVVVVV
844 #define INT_BYTEVVVVVV INT_DOUBLEVVVVVV
845 #define INT_BYTEVVVVVVV INT_DOUBLEVVVVVVV
846 #define INT_DOUBLEV( N,A,B,Y,Z) CFARGS##N(A,INTV,B,Y,Z,0)
847 #define INT_DOUBLEVV( N,A,B,Y,Z) CFARGS##N(A,INTVV,B,Y,Z,0)
848 #define INT_DOUBLEVVV( N,A,B,Y,Z) CFARGS##N(A,INTVVV,B,Y,Z,0)
849 #define INT_DOUBLEVVVV( N,A,B,Y,Z) CFARGS##N(A,INTVVVV,B,Y,Z,0)
850 #define INT_DOUBLEVVVVV( N,A,B,Y,Z) CFARGS##N(A,INTVVVVV,B,Y,Z,0)
851 #define INT_DOUBLEVVVVVV( N,A,B,Y,Z) CFARGS##N(A,INTVVVVVV,B,Y,Z,0)
852 #define INT_DOUBLEVVVVVVV(N,A,B,Y,Z) CFARGS##N(A,INTVVVVVVV,B,Y,Z,0)
853 #define INT_FLOATV INT_DOUBLEV
854 #define INT_FLOATVV INT_DOUBLEVV
855 #define INT_FLOATVVV INT_DOUBLEVVV
856 #define INT_FLOATVVVV INT_DOUBLEVVVV
857 #define INT_FLOATVVVVV INT_DOUBLEVVVVV
858 #define INT_FLOATVVVVVV INT_DOUBLEVVVVVV
859 #define INT_FLOATVVVVVVV INT_DOUBLEVVVVVVV
860 #define INT_INTV INT_DOUBLEV
861 #define INT_INTVV INT_DOUBLEVV
862 #define INT_INTVVV INT_DOUBLEVVV
863 #define INT_INTVVVV INT_DOUBLEVVVV
864 #define INT_INTVVVVV INT_DOUBLEVVVVV
865 #define INT_INTVVVVVV INT_DOUBLEVVVVVV
866 #define INT_INTVVVVVVV INT_DOUBLEVVVVVVV
867 #define INT_LOGICALV INT_DOUBLEV
868 #define INT_LOGICALVV INT_DOUBLEVV
869 #define INT_LOGICALVVV INT_DOUBLEVVV
870 #define INT_LOGICALVVVV INT_DOUBLEVVVV
871 #define INT_LOGICALVVVVV INT_DOUBLEVVVVV
872 #define INT_LOGICALVVVVVV INT_DOUBLEVVVVVV
873 #define INT_LOGICALVVVVVVV INT_DOUBLEVVVVVVV
874 #define INT_LONGV INT_DOUBLEV
875 #define INT_LONGVV INT_DOUBLEVV
876 #define INT_LONGVVV INT_DOUBLEVVV
877 #define INT_LONGVVVV INT_DOUBLEVVVV
878 #define INT_LONGVVVVV INT_DOUBLEVVVVV
879 #define INT_LONGVVVVVV INT_DOUBLEVVVVVV
880 #define INT_LONGVVVVVVV INT_DOUBLEVVVVVVV
881 #define INT_SHORTV INT_DOUBLEV
882 #define INT_SHORTVV INT_DOUBLEVV
883 #define INT_SHORTVVV INT_DOUBLEVVV
884 #define INT_SHORTVVVV INT_DOUBLEVVVV
885 #define INT_SHORTVVVVV INT_DOUBLEVVVVV
886 #define INT_SHORTVVVVVV INT_DOUBLEVVVVVV
887 #define INT_SHORTVVVVVVV INT_DOUBLEVVVVVVV
888 #define INT_PVOID( N,A,B,Y,Z) CFARGS##N(A,B,B,Y,Z,0)
889 #define INT_ROUTINE INT_PVOID
890 /*CRAY coughs on the first, i.e. the usual trouble of not being able to
891  define macros to macros with arguments. */
892 /*#define INT_SIMPLE INT_PVOID*/
893 #define INT_SIMPLE( N,A,B,Y,Z) INT_PVOID(N,A,B,Y,Z)
894 #define INT_VOID INT_PVOID
895 #define INT_STRING INT_PVOID
896 #define INT_STRINGV INT_PVOID
897 #define INT_PSTRING INT_PVOID
898 #define INT_PSTRINGV INT_PVOID
899 #define INT_PNSTRING INT_PVOID
900 #define INT_PPSTRING INT_PVOID
901 #define INT_ZTRINGV INT_PVOID
902 #define INT_PZTRINGV INT_PVOID
903 #define INT_STRVOID INT_PVOID
904 #define INT_CF_0( N,A,B,Y,Z)
905 
906 #define UCF(TN,I,C) _SEP_(TN,C,COMMA) _INT(2,U,TN,A##I,0)
907 #define UUCF(TN,I,C) _SEP_(TN,C,COMMA) _SEP_(TN,1,I)
908 #define UUUCF(TN,I,C) _SEP_(TN,C,COLON) _INT(2,U,TN,A##I,0)
909 #define UINT( T,A) typeP##T##VVVVVVV A
910 #define UINTV( T,A) typeP##T##VVVVVV *A
911 #define UINTVV( T,A) typeP##T##VVVVV *A
912 #define UINTVVV( T,A) typeP##T##VVVV *A
913 #define UINTVVVV( T,A) typeP##T##VVV *A
914 #define UINTVVVVV( T,A) typeP##T##VV *A
915 #define UINTVVVVVV( T,A) typeP##T##V *A
916 #define UINTVVVVVVV(T,A) typeP##T *A
917 #define UPINT( T,A) type##T##VVVVVVV *A
918 #define UPVOID( T,A) void *A
919 #define UROUTINE( T,A) void (*A)()
920 #define UVOID( T,A) void A /* Needed for C calls FORTRAN subroutines. */
921 #define USTRING( T,A) char *A /* via VOID and wrapper. */
922 #define USTRINGV( T,A) char *A
923 #define UPSTRING( T,A) char *A
924 #define UPSTRINGV( T,A) char *A
925 #define UZTRINGV( T,A) char *A
926 #define UPZTRINGV( T,A) char *A
927 
928 /* VOID breaks U into U and UU. */
929 #define UUINT( T,A) typeP##T##VVVVVVV A
930 #define UUVOID( T,A) /* Needed for FORTRAN calls C subroutines. */
931 #define UUSTRING( T,A) char *A
932 
933 /* Sun and VOID break U into U and PU. */
934 #define PUBYTE( A) INTEGER_BYTE A
935 #define PUDOUBLE( A) DOUBLE_PRECISION A
936 #ifndef sunFortran
937 #define PUFLOAT( A) float A
938 #else
939 #define PUFLOAT( A) FLOATFUNCTIONTYPE A
940 #endif
941 #define PUINT( A) int A
942 #define PULOGICAL( A) int A
943 #define PULONG( A) long A
944 #define PUSHORT( A) short A
945 #define PUSTRING( A) char *A
946 #define PUVOID( A) void A
947 
948 #define EBYTE INTEGER_BYTE A0;
949 #define EDOUBLE DOUBLE_PRECISION A0;
950 #ifndef sunFortran
951 #define EFLOAT float A0;
952 #else
953 #define EFLOAT float AA0; FLOATFUNCTIONTYPE A0;
954 #endif
955 #define EINT int A0;
956 #define ELOGICAL int A0;
957 #define ELONG long A0;
958 #define ESHORT short A0;
959 #define EVOID
960 #ifdef vmsFortran
961 #define ESTRING static char AA0[MAX_LEN_FORTRAN_FUNCTION_STRING+1]; \
962  static fstring A0 = \
963  {MAX_LEN_FORTRAN_FUNCTION_STRING,DSC$K_DTYPE_T,DSC$K_CLASS_S,AA0};\
964  memset(AA0, CFORTRAN_NON_CHAR, MAX_LEN_FORTRAN_FUNCTION_STRING);\
965  *(AA0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0';
966 #else
967 #ifdef CRAYFortran
968 #define ESTRING static char AA0[MAX_LEN_FORTRAN_FUNCTION_STRING+1]; \
969  static _fcd A0; *(AA0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0';\
970  memset(AA0,CFORTRAN_NON_CHAR, MAX_LEN_FORTRAN_FUNCTION_STRING);\
971  A0 = _cptofcd(AA0,MAX_LEN_FORTRAN_FUNCTION_STRING);
972 #else
973 #define ESTRING static char A0[MAX_LEN_FORTRAN_FUNCTION_STRING+1]; \
974  memset(A0, CFORTRAN_NON_CHAR, \
975  MAX_LEN_FORTRAN_FUNCTION_STRING); \
976  *(A0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0';
977 #endif
978 #endif
979 /* ESTRING must use static char. array which is guaranteed to exist after
980  function returns. */
981 
982 /* N.B.i) The diff. for 0 (Zero) and >=1 arguments.
983  ii)That the following create an unmatched bracket, i.e. '(', which
984  must of course be matched in the call.
985  iii)Commas must be handled very carefully */
986 #define GZINT( T,UN,LN) A0=CFC_(UN,LN)(
987 #define GZVOID( T,UN,LN) CFC_(UN,LN)(
988 #ifdef vmsFortran
989 #define GZSTRING( T,UN,LN) CFC_(UN,LN)(&A0
990 #else
991 #ifdef CRAYFortran
992 #define GZSTRING( T,UN,LN) CFC_(UN,LN)( A0
993 #else
994 #define GZSTRING( T,UN,LN) CFC_(UN,LN)( A0,MAX_LEN_FORTRAN_FUNCTION_STRING
995 #endif
996 #endif
997 
998 #define GINT GZINT
999 #define GVOID GZVOID
1000 #define GSTRING( T,UN,LN) GZSTRING(T,UN,LN),
1001 
1002 #define PPBYTEVVVVVVV
1003 #define PPINTVVVVVVV /* These complement PPFLOATVVVVVVV. */
1004 #define PPDOUBLEVVVVVVV
1005 #define PPLOGICALVVVVVVV
1006 #define PPLONGVVVVVVV
1007 #define PPSHORTVVVVVVV
1008 
1009 #define BCF(TN,AN,C) _SEP_(TN,C,COMMA) _INT(2,B,TN,AN,0)
1010 #define BINT( T,A) (typeP##T##VVVVVVV) A
1011 #define BINTV( T,A) A
1012 #define BINTVV( T,A) (A)[0]
1013 #define BINTVVV( T,A) (A)[0][0]
1014 #define BINTVVVV( T,A) (A)[0][0][0]
1015 #define BINTVVVVV( T,A) (A)[0][0][0][0]
1016 #define BINTVVVVVV( T,A) (A)[0][0][0][0][0]
1017 #define BINTVVVVVVV(T,A) (A)[0][0][0][0][0][0]
1018 #define BPINT( T,A) P##T##VVVVVVV &A
1019 #define BSTRING( T,A) (char *) A
1020 #define BSTRINGV( T,A) (char *) A
1021 #define BPSTRING( T,A) (char *) A
1022 #define BPSTRINGV( T,A) (char *) A
1023 #define BPVOID( T,A) (void *) A
1024 #define BROUTINE( T,A) (void(*)())A
1025 #define BZTRINGV( T,A) (char *) A
1026 #define BPZTRINGV( T,A) (char *) A
1027 
1028 #define ZCF(TN,N,AN) _INT(3,Z,TN,N,AN)
1029 #define ZINT( T,I,A) (__cfztringv[I]=(int)A),
1030 #define ZPINT ZINT
1031 #define ZINTV( T,I,A)
1032 #define ZINTVV( T,I,A)
1033 #define ZINTVVV( T,I,A)
1034 #define ZINTVVVV( T,I,A)
1035 #define ZINTVVVVV( T,I,A)
1036 #define ZINTVVVVVV( T,I,A)
1037 #define ZINTVVVVVVV(T,I,A)
1038 #define ZSTRING( T,I,A)
1039 #define ZSTRINGV( T,I,A)
1040 #define ZPSTRING( T,I,A)
1041 #define ZPSTRINGV( T,I,A)
1042 #define ZPVOID( T,I,A)
1043 #define ZROUTINE( T,I,A)
1044 #define ZSIMPLE( T,I,A)
1045 #define ZZTRINGV( T,I,A)
1046 #define ZPZTRINGV( T,I,A)
1047 
1048 #define SCF(TN,NAME,I,A) STR_##TN(3,S,NAME,I,A,0)
1049 #define SLOGICAL( M,I,A)
1050 #define SPLOGICAL(M,I,A)
1051 #define SSTRING( M,I,A) ,sizeof(A)
1052 #define SSTRINGV( M,I,A) ,( (unsigned)0xFFFF*firstindexlength(A) \
1053  +secondindexlength(A))
1054 #define SPSTRING( M,I,A) ,sizeof(A)
1055 #define SPSTRINGV SSTRINGV
1056 #define SZTRINGV( M,I,A) ,( (unsigned)0xFFFF*M##_ELEMS_##I \
1057  +M##_ELEMLEN_##I+1)
1058 #define SPZTRINGV SZTRINGV
1059 
1060 #define HCF(TN,I) STR_##TN(3,H,COMMA, H,C##I,0)
1061 #define HHCF(TN,I) STR_##TN(3,H,COMMA,HH,C##I,0)
1062 #define HHHCF(TN,I) STR_##TN(3,H,COLON, H,C##I,0)
1063 #define H_CF_SPECIAL unsigned
1064 #define HH_CF_SPECIAL
1065 #define HLOGICAL( S,U,B)
1066 #define HPLOGICAL(S,U,B)
1067 #define HSTRING( S,U,B) A##S U##_CF_SPECIAL B
1068 #define HSTRINGV HSTRING
1069 #define HPSTRING HSTRING
1070 #define HPSTRINGV HSTRING
1071 #define HPNSTRING HSTRING
1072 #define HPPSTRING HSTRING
1073 #define HSTRVOID HSTRING
1074 #define HZTRINGV HSTRING
1075 #define HPZTRINGV HSTRING
1076 
1077 #define STR_BYTE( N,T,A,B,C,D)
1078 #define STR_DOUBLE( N,T,A,B,C,D) /* Can't add spaces inside */
1079 #define STR_FLOAT( N,T,A,B,C,D) /* expansion since it screws up */
1080 #define STR_INT( N,T,A,B,C,D) /* macro catenation kludge. */
1081 #define STR_LOGICAL( N,T,A,B,C,D) CFARGS##N(T,LOGICAL,A,B,C,D)
1082 #define STR_LONG( N,T,A,B,C,D)
1083 #define STR_SHORT( N,T,A,B,C,D)
1084 #define STR_BYTEV( N,T,A,B,C,D)
1085 #define STR_BYTEVV( N,T,A,B,C,D)
1086 #define STR_BYTEVVV( N,T,A,B,C,D)
1087 #define STR_BYTEVVVV( N,T,A,B,C,D)
1088 #define STR_BYTEVVVVV( N,T,A,B,C,D)
1089 #define STR_BYTEVVVVVV( N,T,A,B,C,D)
1090 #define STR_BYTEVVVVVVV( N,T,A,B,C,D)
1091 #define STR_DOUBLEV( N,T,A,B,C,D)
1092 #define STR_DOUBLEVV( N,T,A,B,C,D)
1093 #define STR_DOUBLEVVV( N,T,A,B,C,D)
1094 #define STR_DOUBLEVVVV( N,T,A,B,C,D)
1095 #define STR_DOUBLEVVVVV( N,T,A,B,C,D)
1096 #define STR_DOUBLEVVVVVV( N,T,A,B,C,D)
1097 #define STR_DOUBLEVVVVVVV( N,T,A,B,C,D)
1098 #define STR_FLOATV( N,T,A,B,C,D)
1099 #define STR_FLOATVV( N,T,A,B,C,D)
1100 #define STR_FLOATVVV( N,T,A,B,C,D)
1101 #define STR_FLOATVVVV( N,T,A,B,C,D)
1102 #define STR_FLOATVVVVV( N,T,A,B,C,D)
1103 #define STR_FLOATVVVVVV( N,T,A,B,C,D)
1104 #define STR_FLOATVVVVVVV( N,T,A,B,C,D)
1105 #define STR_INTV( N,T,A,B,C,D)
1106 #define STR_INTVV( N,T,A,B,C,D)
1107 #define STR_INTVVV( N,T,A,B,C,D)
1108 #define STR_INTVVVV( N,T,A,B,C,D)
1109 #define STR_INTVVVVV( N,T,A,B,C,D)
1110 #define STR_INTVVVVVV( N,T,A,B,C,D)
1111 #define STR_INTVVVVVVV( N,T,A,B,C,D)
1112 #define STR_LOGICALV( N,T,A,B,C,D)
1113 #define STR_LOGICALVV( N,T,A,B,C,D)
1114 #define STR_LOGICALVVV( N,T,A,B,C,D)
1115 #define STR_LOGICALVVVV( N,T,A,B,C,D)
1116 #define STR_LOGICALVVVVV( N,T,A,B,C,D)
1117 #define STR_LOGICALVVVVVV( N,T,A,B,C,D)
1118 #define STR_LOGICALVVVVVVV(N,T,A,B,C,D)
1119 #define STR_LONGV( N,T,A,B,C,D)
1120 #define STR_LONGVV( N,T,A,B,C,D)
1121 #define STR_LONGVVV( N,T,A,B,C,D)
1122 #define STR_LONGVVVV( N,T,A,B,C,D)
1123 #define STR_LONGVVVVV( N,T,A,B,C,D)
1124 #define STR_LONGVVVVVV( N,T,A,B,C,D)
1125 #define STR_LONGVVVVVVV( N,T,A,B,C,D)
1126 #define STR_SHORTV( N,T,A,B,C,D)
1127 #define STR_SHORTVV( N,T,A,B,C,D)
1128 #define STR_SHORTVVV( N,T,A,B,C,D)
1129 #define STR_SHORTVVVV( N,T,A,B,C,D)
1130 #define STR_SHORTVVVVV( N,T,A,B,C,D)
1131 #define STR_SHORTVVVVVV( N,T,A,B,C,D)
1132 #define STR_SHORTVVVVVVV( N,T,A,B,C,D)
1133 #define STR_PBYTE( N,T,A,B,C,D)
1134 #define STR_PDOUBLE( N,T,A,B,C,D)
1135 #define STR_PFLOAT( N,T,A,B,C,D)
1136 #define STR_PINT( N,T,A,B,C,D)
1137 #define STR_PLOGICAL( N,T,A,B,C,D) CFARGS##N(T,PLOGICAL,A,B,C,D)
1138 #define STR_PLONG( N,T,A,B,C,D)
1139 #define STR_PSHORT( N,T,A,B,C,D)
1140 #define STR_STRING( N,T,A,B,C,D) CFARGS##N(T,STRING,A,B,C,D)
1141 #define STR_PSTRING( N,T,A,B,C,D) CFARGS##N(T,PSTRING,A,B,C,D)
1142 #define STR_STRINGV( N,T,A,B,C,D) CFARGS##N(T,STRINGV,A,B,C,D)
1143 #define STR_PSTRINGV( N,T,A,B,C,D) CFARGS##N(T,PSTRINGV,A,B,C,D)
1144 #define STR_PNSTRING( N,T,A,B,C,D) CFARGS##N(T,PNSTRING,A,B,C,D)
1145 #define STR_PPSTRING( N,T,A,B,C,D) CFARGS##N(T,PPSTRING,A,B,C,D)
1146 #define STR_STRVOID( N,T,A,B,C,D) CFARGS##N(T,STRVOID,A,B,C,D)
1147 #define STR_PVOID( N,T,A,B,C,D)
1148 #define STR_ROUTINE( N,T,A,B,C,D)
1149 #define STR_SIMPLE( N,T,A,B,C,D)
1150 #define STR_ZTRINGV( N,T,A,B,C,D) CFARGS##N(T,ZTRINGV,A,B,C,D)
1151 #define STR_PZTRINGV( N,T,A,B,C,D) CFARGS##N(T,PZTRINGV,A,B,C,D)
1152 #define STR_CF_0( N,T,A,B,C,D)
1153 
1154 /* See ACF table comments, which explain why CCF was split into two. */
1155 #define CCF(TN,I) STR_##TN(3,C,A##I,B##I,C##I,0)
1156 #define CLOGICAL( A,B,C) A=C2FLOGICAL( A);
1157 #define CPLOGICAL(A,B,C) *A=C2FLOGICAL(*A);
1158 #ifdef vmsFortran
1159 #define CSTRING( A,B,C) (B.clen=strlen(A),B.f.dsc$a_pointer=A, \
1160  C==sizeof(char*)||C==B.clen+1?B.f.dsc$w_length=B.clen: \
1161  (memset((A)+B.clen,' ',C-B.clen-1),A[B.f.dsc$w_length=C-1]='\0'));
1162 #define CSTRINGV( A,B,C) ( \
1163  initfstr(B, malloc((C/0xFFFF)*(C%0xFFFF-1)), C/0xFFFF, C%0xFFFF-1), \
1164  c2fstrv(A,B.dsc$a_pointer,C%0xFFFF,(C/0xFFFF)*(C%0xFFFF)) );
1165 #define CPSTRING( A,B,C) (B.dsc$w_length=strlen(A),B.dsc$a_pointer=A, \
1166  C==sizeof(char*)?0:(memset((A)+B.dsc$w_length,' ',C-B.dsc$w_length-1), \
1167  A[B.dsc$w_length=C-1]='\0'));
1168 #define CPSTRINGV(A,B,C) (initfstr(B, A, C/0xFFFF, C%0xFFFF-1), \
1169  c2fstrv(A,A,C%0xFFFF,(C/0xFFFF)*(C%0xFFFF)) );
1170 #else
1171 #ifdef CRAYFortran
1172 #define CSTRING( A,B,C) (B.clen=strlen(A), \
1173  C==sizeof(char*)||C==B.clen+1?B.flen=B.clen: \
1174  (memset((A)+B.clen,' ',C-B.clen-1),A[B.flen=C-1]='\0'));
1175 #define CSTRINGV( A,B,C) (B.s=malloc((C/0xFFFF)*(C%0xFFFF-1)), \
1176  c2fstrv(A,B.s,(B.flen=C%0xFFFF-1)+1,(C/0xFFFF)*(C%0xFFFF)));
1177 #define CPSTRING( A,B,C) (B=strlen(A), C==sizeof(char*)?0: \
1178  (memset((A)+B,' ',C-B-1),A[B=C-1]='\0'));
1179 #define CPSTRINGV(A,B,C) c2fstrv(A,A,(B.flen=C%0xFFFF-1)+1, \
1180  B.sizeofA=(C/0xFFFF)*(C%0xFFFF));
1181 #else
1182 #define CSTRING( A,B,C) (B.clen=strlen(A), \
1183  C==sizeof(char*)||C==B.clen+1?B.flen=B.clen: \
1184  (memset((A)+B.clen,' ',C-B.clen-1),A[B.flen=C-1]='\0'));
1185 #define CSTRINGV( A,B,C) (B.s=malloc((C/0xFFFF)*(C%0xFFFF-1)), \
1186  B.fs=c2fstrv(A,B.s,(B.flen=C%0xFFFF-1)+1,(C/0xFFFF)*(C%0xFFFF)));
1187 #define CPSTRING( A,B,C) (B=strlen(A), C==sizeof(char*)?0: \
1188  (memset((A)+B,' ',C-B-1),A[B=C-1]='\0'));
1189 #define CPSTRINGV(A,B,C) B.fs=c2fstrv(A,A,(B.flen=C%0xFFFF-1)+1, \
1190  B.sizeofA=(C/0xFFFF)*(C%0xFFFF));
1191 #endif
1192 #endif
1193 #define CZTRINGV CSTRINGV
1194 #define CPZTRINGV CPSTRINGV
1195 
1196 #define CCCBYTE( A,B) &A
1197 #define CCCDOUBLE( A,B) &A
1198 #if !defined(__CF__KnR)
1199 #define CCCFLOAT( A,B) &A
1200  /* Although the VAX doesn't, at least the */
1201 #else /* HP and K&R mips promote float arg.'s of */
1202 #define CCCFLOAT( A,B) &B /* unprototyped functions to double. So we can't */
1203 #endif /* use A here to pass the argument to FORTRAN. */
1204 #define CCCINT( A,B) &A
1205 #define CCCLOGICAL( A,B) &A
1206 #define CCCLONG( A,B) &A
1207 #define CCCSHORT( A,B) &A
1208 #define CCCPBYTE( A,B) A
1209 #define CCCPDOUBLE( A,B) A
1210 #define CCCPFLOAT( A,B) A
1211 #define CCCPINT( A,B) A
1212 #define CCCPLOGICAL(A,B) B=A /* B used to keep a common W table. */
1213 #define CCCPLONG( A,B) A
1214 #define CCCPSHORT( A,B) A
1215 
1216 #define CCCF(TN,I,M) _SEP_(TN,M,COMMA) _INT(3,CC,TN,A##I,B##I)
1217 #define CCINT( T,A,B) CCC##T(A,B)
1218 #define CCINTV( T,A,B) A
1219 #define CCINTVV( T,A,B) A
1220 #define CCINTVVV( T,A,B) A
1221 #define CCINTVVVV( T,A,B) A
1222 #define CCINTVVVVV( T,A,B) A
1223 #define CCINTVVVVVV( T,A,B) A
1224 #define CCINTVVVVVVV(T,A,B) A
1225 #define CCPINT( T,A,B) CCC##T(A,B)
1226 #define CCPVOID( T,A,B) A
1227 #ifdef apolloFortran
1228 #define CCROUTINE( T,A,B) &A
1229 #else
1230 #define CCROUTINE( T,A,B) A
1231 #endif
1232 #define CCSIMPLE( T,A,B) A
1233 #ifdef vmsFortran
1234 #define CCSTRING( T,A,B) &B.f
1235 #define CCSTRINGV( T,A,B) &B
1236 #define CCPSTRING( T,A,B) &B
1237 #define CCPSTRINGV( T,A,B) &B
1238 #else
1239 #ifdef CRAYFortran
1240 #define CCSTRING( T,A,B) _cptofcd(A,B.flen)
1241 #define CCSTRINGV( T,A,B) _cptofcd(B.s,B.flen)
1242 #define CCPSTRING( T,A,B) _cptofcd(A,B)
1243 #define CCPSTRINGV( T,A,B) _cptofcd(A,B.flen)
1244 #else
1245 #define CCSTRING( T,A,B) A
1246 #define CCSTRINGV( T,A,B) B.fs
1247 #define CCPSTRING( T,A,B) A
1248 #define CCPSTRINGV( T,A,B) B.fs
1249 #endif
1250 #endif
1251 #define CCZTRINGV CCSTRINGV
1252 #define CCPZTRINGV CCPSTRINGV
1253 
1254 #define XBYTE return A0;
1255 #define XDOUBLE return A0;
1256 #ifndef sunFortran
1257 #define XFLOAT return A0;
1258 #else
1259 #define XFLOAT ASSIGNFLOAT(AA0,A0); return AA0;
1260 #endif
1261 #define XINT return A0;
1262 #define XLOGICAL return F2CLOGICAL(A0);
1263 #define XLONG return A0;
1264 #define XSHORT return A0;
1265 #define XVOID return ;
1266 #if defined(vmsFortran) || defined(CRAYFortran)
1267 #define XSTRING return kill_trailing( \
1268  kill_trailing(AA0,CFORTRAN_NON_CHAR),' ');
1269 #else
1270 #define XSTRING return kill_trailing( \
1271  kill_trailing( A0,CFORTRAN_NON_CHAR),' ');
1272 #endif
1273 
1274 #define CFFUN(NAME) __cf__##NAME
1275 
1276 /* Note that we don't use LN here, but we keep it for consistency. */
1277 #define CCALLSFFUN0(UN,LN) CFFUN(UN)()
1278 
1279 #ifdef OLD_VAXC /* Allow %CC-I-PARAMNOTUSED. */
1280 #pragma standard
1281 #endif
1282 
1283 #define CCALLSFFUN1( UN,LN,T1, A1) \
1284  CCALLSFFUN5 (UN,LN,T1,CF_0,CF_0,CF_0,CF_0,A1,0,0,0,0)
1285 #define CCALLSFFUN2( UN,LN,T1,T2, A1,A2) \
1286  CCALLSFFUN5 (UN,LN,T1,T2,CF_0,CF_0,CF_0,A1,A2,0,0,0)
1287 #define CCALLSFFUN3( UN,LN,T1,T2,T3, A1,A2,A3) \
1288  CCALLSFFUN5 (UN,LN,T1,T2,T3,CF_0,CF_0,A1,A2,A3,0,0)
1289 #define CCALLSFFUN4( UN,LN,T1,T2,T3,T4, A1,A2,A3,A4)\
1290  CCALLSFFUN5 (UN,LN,T1,T2,T3,T4,CF_0,A1,A2,A3,A4,0)
1291 #define CCALLSFFUN5( UN,LN,T1,T2,T3,T4,T5, A1,A2,A3,A4,A5) \
1292  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)
1293 #define CCALLSFFUN6( UN,LN,T1,T2,T3,T4,T5,T6, A1,A2,A3,A4,A5,A6) \
1294  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)
1295 #define CCALLSFFUN7( UN,LN,T1,T2,T3,T4,T5,T6,T7, A1,A2,A3,A4,A5,A6,A7) \
1296  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)
1297 #define CCALLSFFUN8( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8, A1,A2,A3,A4,A5,A6,A7,A8) \
1298  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)
1299 #define CCALLSFFUN9( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,A1,A2,A3,A4,A5,A6,A7,A8,A9)\
1300  CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,0)
1301 
1302 #define CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA)\
1303 (ZCF(T1,1,A1) ZCF(T2,2,A2) ZCF(T3,3,A3) ZCF(T4,4,A4) ZCF(T5,5,A5) \
1304  ZCF(T6,6,A6) ZCF(T7,7,A7) ZCF(T8,8,A8) ZCF(T9,9,A9) ZCF(TA,A,AA) \
1305  (CFFUN(UN)( BCF(T1,A1,0) BCF(T2,A2,1) BCF(T3,A3,1) BCF(T4,A4,1) BCF(T5,A5,1) \
1306  BCF(T6,A6,1) BCF(T7,A7,1) BCF(T8,A8,1) BCF(T9,A9,1) BCF(TA,AA,1) \
1307  SCF(T1,LN,1,A1) SCF(T2,LN,2,A2) SCF(T3,LN,3,A3) SCF(T4,LN,4,A4) \
1308  SCF(T5,LN,5,A5) SCF(T6,LN,6,A6) SCF(T7,LN,7,A7) SCF(T8,LN,8,A8) \
1309  SCF(T9,LN,9,A9) SCF(TA,LN,A,AA))))
1310 
1311 /* N.B. Create a separate function instead of using (call function, function
1312 value here) because in order to create the variables needed for the input
1313 arg.'s which may be const.'s one has to do the creation within {}, but these
1314 can never be placed within ()'s. Therefore one must create wrapper functions.
1315 gcc, on the other hand may be able to avoid the wrapper functions. */
1316 
1317 /* Prototypes are needed to correctly handle the value returned correctly. N.B.
1318 Can only have prototype arg.'s with difficulty, a la G... table since FORTRAN
1319 functions returning strings have extra arg.'s. Don't bother, since this only
1320 causes a compiler warning to come up when one uses FCALLSCFUNn and CCALLSFFUNn
1321 for the same function in the same source code. Something done by the experts in
1322 debugging only.*/
1323 
1324 #define PROTOCCALLSFFUN0(F,UN,LN) \
1325 PU##F( CFC_(UN,LN))(CF_NULL_PROTO); \
1326 static _INT(2,U,F,CFFUN(UN),0)() {E##F _INT(3,GZ,F,UN,LN)); X##F}
1327 
1328 #define PROTOCCALLSFFUN1( T0,UN,LN,T1) \
1329  PROTOCCALLSFFUN5 (T0,UN,LN,T1,CF_0,CF_0,CF_0,CF_0)
1330 #define PROTOCCALLSFFUN2( T0,UN,LN,T1,T2) \
1331  PROTOCCALLSFFUN5 (T0,UN,LN,T1,T2,CF_0,CF_0,CF_0)
1332 #define PROTOCCALLSFFUN3( T0,UN,LN,T1,T2,T3) \
1333  PROTOCCALLSFFUN5 (T0,UN,LN,T1,T2,T3,CF_0,CF_0)
1334 #define PROTOCCALLSFFUN4( T0,UN,LN,T1,T2,T3,T4) \
1335  PROTOCCALLSFFUN5 (T0,UN,LN,T1,T2,T3,T4,CF_0)
1336 #define PROTOCCALLSFFUN5( T0,UN,LN,T1,T2,T3,T4,T5) \
1337  PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0)
1338 #define PROTOCCALLSFFUN6( T0,UN,LN,T1,T2,T3,T4,T5,T6) \
1339  PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0)
1340 #define PROTOCCALLSFFUN7( T0,UN,LN,T1,T2,T3,T4,T5,T6,T7) \
1341  PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0)
1342 #define PROTOCCALLSFFUN8( T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \
1343  PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0)
1344 #define PROTOCCALLSFFUN9( T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \
1345  PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0)
1346 
1347 /* HP/UX 9.01 cc requires the blank between '_INT(3,G,T0,UN,LN) CCCF(T1,1,0)' */
1348 
1349 #ifndef __CF__KnR
1350 #define PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \
1351 PU##T0(CFC_(UN,LN))(CF_NULL_PROTO); \
1352 static _INT(2,U,T0,CFFUN(UN),0)(UCF(T1,1,0) UCF(T2,2,1) UCF(T3,3,1) UCF(T4,4,1) \
1353  UCF(T5,5,1) UCF(T6,6,1) UCF(T7,7,1) UCF(T8,8,1) UCF(T9,9,1) UCF(TA,A,1) \
1354  HCF(T1,1) HCF(T2,2) HCF(T3,3) HCF(T4,4) HCF(T5,5) \
1355  HCF(T6,6) HCF(T7,7) HCF(T8,8) HCF(T9,9) HCF(TA,A) ) \
1356 {VCF(T1,1) VCF(T2,2) VCF(T3,3) VCF(T4,4) VCF(T5,5) \
1357  VCF(T6,6) VCF(T7,7) VCF(T8,8) VCF(T9,9) VCF(TA,A) E##T0 \
1358  CCF(T1,1) CCF(T2,2) CCF(T3,3) CCF(T4,4) CCF(T5,5) \
1359  CCF(T6,6) CCF(T7,7) CCF(T8,8) CCF(T9,9) CCF(TA,A) \
1360  _INT(3,G,T0,UN,LN) CCCF(T1,1,0) CCCF(T2,2,1) CCCF(T3,3,1) CCCF(T4,4,1) CCCF(T5,5,1)\
1361  CCCF(T6,6,1) CCCF(T7,7,1) CCCF(T8,8,1) CCCF(T9,9,1) CCCF(TA,A,1)\
1362  JCF(T1,1) JCF(T2,2) JCF(T3,3) JCF(T4,4) JCF(T5,5) \
1363  JCF(T6,6) JCF(T7,7) JCF(T8,8) JCF(T9,9) JCF(TA,A)); \
1364  WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) \
1365  WCF(T6,A6,6) WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,AA,A) X##T0}
1366 #else
1367 #define PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \
1368 PU##T0(CFC_(UN,LN))(CF_NULL_PROTO); \
1369 static _INT(2,U,T0,CFFUN(UN),0)(UUCF(T1,1,0) UUCF(T2,2,1) UUCF(T3,3,1) UUCF(T4,4,1) \
1370  UUCF(T5,5,1) UUCF(T6,6,1) UUCF(T7,7,1) UUCF(T8,8,1) UUCF(T9,9,1) UUCF(TA,A,1) \
1371  HHCF(T1,1) HHCF(T2,2) HHCF(T3,3) HHCF(T4,4) HHCF(T5,5) \
1372  HHCF(T6,6) HHCF(T7,7) HHCF(T8,8) HHCF(T9,9) HHCF(TA,A)) \
1373  UUUCF(T1,1,0) UUUCF(T2,2,1) UUUCF(T3,3,1) UUUCF(T4,4,1) UUUCF(T5,5,1) \
1374  UUUCF(T6,6,1) UUUCF(T7,7,1) UUUCF(T8,8,1) UUUCF(T9,9,1) UUUCF(TA,A,1) \
1375  HHHCF(T1,1) HHHCF(T2,2) HHHCF(T3,3) HHHCF(T4,4) HHHCF(T5,5) \
1376  HHHCF(T6,6) HHHCF(T7,7) HHHCF(T8,8) HHHCF(T9,9) HHHCF(TA,A); \
1377 {VCF(T1,1) VCF(T2,2) VCF(T3,3) VCF(T4,4) VCF(T5,5) \
1378  VCF(T6,6) VCF(T7,7) VCF(T8,8) VCF(T9,9) VCF(TA,A) E##T0 \
1379  CCF(T1,1) CCF(T2,2) CCF(T3,3) CCF(T4,4) CCF(T5,5) \
1380  CCF(T6,6) CCF(T7,7) CCF(T8,8) CCF(T9,9) CCF(TA,A) \
1381  _INT(3,G,T0,UN,LN) CCCF(T1,1,0) CCCF(T2,2,1) CCCF(T3,3,1) CCCF(T4,4,1) CCCF(T5,5,1)\
1382  CCCF(T6,6,1) CCCF(T7,7,1) CCCF(T8,8,1) CCCF(T9,9,1) CCCF(TA,A,1)\
1383  JCF(T1,1) JCF(T2,2) JCF(T3,3) JCF(T4,4) JCF(T5,5) \
1384  JCF(T6,6) JCF(T7,7) JCF(T8,8) JCF(T9,9) JCF(TA,A) ); \
1385  WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) \
1386  WCF(T6,A6,6) WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,AA,A) X##T0}
1387 #endif
1388 
1389 /*-------------------------------------------------------------------------*/
1390 
1391 /* UTILITIES FOR FORTRAN TO CALL C ROUTINES */
1392 
1393 #ifdef OLD_VAXC /* Prevent %CC-I-PARAMNOTUSED. */
1394 #pragma nostandard
1395 #endif
1396 
1397 #if defined(vmsFortran) || defined(CRAYFortran)
1398 #define DCF(TN,I)
1399 #define DDCF(TN,I)
1400 #define DDDCF(TN,I)
1401 #else
1402 #define DCF HCF
1403 #define DDCF HHCF
1404 #define DDDCF HHHCF
1405 #endif
1406 
1407 #define QCF(TN,I) STR_##TN(1,Q,B##I, 0,0,0)
1408 #define QLOGICAL( B)
1409 #define QPLOGICAL(B)
1410 #define QSTRINGV( B) char *B; unsigned int B##N;
1411 #define QSTRING( B) char *B=NULL;
1412 #define QPSTRING( B) char *B=NULL;
1413 #define QPSTRINGV QSTRINGV
1414 #define QPNSTRING(B) char *B=NULL;
1415 #define QPPSTRING(B)
1416 #define QSTRVOID( B)
1417 
1418 #ifdef apolloFortran
1419 #define ROUTINE_orig (void *)* /* Else, function value has to match. */
1420 #else /* !apolloFortran */
1421 #ifdef __sgi /* Else SGI gives warning 182 contrary to its C LRM A.17.7 */
1422 #define ROUTINE_orig *(void**)&
1423 #else /* !__sgi */
1424 #define ROUTINE_orig (void *)
1425 #endif /* __sgi */
1426 #endif /* apolloFortran */
1427 
1428 #define ROUTINE_1 ROUTINE_orig
1429 #define ROUTINE_2 ROUTINE_orig
1430 #define ROUTINE_3 ROUTINE_orig
1431 #define ROUTINE_4 ROUTINE_orig
1432 #define ROUTINE_5 ROUTINE_orig
1433 #define ROUTINE_6 ROUTINE_orig
1434 #define ROUTINE_7 ROUTINE_orig
1435 #define ROUTINE_8 ROUTINE_orig
1436 #define ROUTINE_9 ROUTINE_orig
1437 #define ROUTINE_10 ROUTINE_orig
1438 
1439 #define ROUTINE_11 ROUTINE_orig
1440 #define ROUTINE_12 ROUTINE_orig
1441 #define ROUTINE_13 ROUTINE_orig
1442 #define ROUTINE_14 ROUTINE_orig
1443 #define ROUTINE_15 ROUTINE_orig
1444 
1445 #define TCF(NAME,TN,I,M) _SEP_(TN,M,COMMA) T##TN(NAME,I,A##I,B##I,C##I)
1446 #define TBYTE( M,I,A,B,D) *A
1447 #define TDOUBLE( M,I,A,B,D) *A
1448 #define TFLOAT( M,I,A,B,D) *A
1449 #define TINT( M,I,A,B,D) *A
1450 #define TLOGICAL( M,I,A,B,D) F2CLOGICAL(*A)
1451 #define TLONG( M,I,A,B,D) *A
1452 #define TSHORT( M,I,A,B,D) *A
1453 #define TBYTEV( M,I,A,B,D) A
1454 #define TDOUBLEV( M,I,A,B,D) A
1455 #define TFLOATV( M,I,A,B,D) VOIDP0 A
1456 #define TINTV( M,I,A,B,D) A
1457 #define TLOGICALV( M,I,A,B,D) A
1458 #define TLONGV( M,I,A,B,D) A
1459 #define TSHORTV( M,I,A,B,D) A
1460 #define TBYTEVV( M,I,A,B,D) (void *)A /* We have to cast to void *, */
1461 #define TBYTEVVV( M,I,A,B,D) (void *)A /* since we don't know the */
1462 #define TBYTEVVVV( M,I,A,B,D) (void *)A /* dimensions of the array. */
1463 #define TBYTEVVVVV( M,I,A,B,D) (void *)A /* i.e. Unfortunately, can't */
1464 #define TBYTEVVVVVV( M,I,A,B,D) (void *)A /* check that the type matches */
1465 #define TBYTEVVVVVVV( M,I,A,B,D) (void *)A /* with the prototype. */
1466 #define TDOUBLEVV( M,I,A,B,D) (void *)A
1467 #define TDOUBLEVVV( M,I,A,B,D) (void *)A
1468 #define TDOUBLEVVVV( M,I,A,B,D) (void *)A
1469 #define TDOUBLEVVVVV( M,I,A,B,D) (void *)A
1470 #define TDOUBLEVVVVVV( M,I,A,B,D) (void *)A
1471 #define TDOUBLEVVVVVVV( M,I,A,B,D) (void *)A
1472 #define TFLOATVV( M,I,A,B,D) (void *)A
1473 #define TFLOATVVV( M,I,A,B,D) (void *)A
1474 #define TFLOATVVVV( M,I,A,B,D) (void *)A
1475 #define TFLOATVVVVV( M,I,A,B,D) (void *)A
1476 #define TFLOATVVVVVV( M,I,A,B,D) (void *)A
1477 #define TFLOATVVVVVVV( M,I,A,B,D) (void *)A
1478 #define TINTVV( M,I,A,B,D) (void *)A
1479 #define TINTVVV( M,I,A,B,D) (void *)A
1480 #define TINTVVVV( M,I,A,B,D) (void *)A
1481 #define TINTVVVVV( M,I,A,B,D) (void *)A
1482 #define TINTVVVVVV( M,I,A,B,D) (void *)A
1483 #define TINTVVVVVVV( M,I,A,B,D) (void *)A
1484 #define TLOGICALVV( M,I,A,B,D) (void *)A
1485 #define TLOGICALVVV( M,I,A,B,D) (void *)A
1486 #define TLOGICALVVVV( M,I,A,B,D) (void *)A
1487 #define TLOGICALVVVVV( M,I,A,B,D) (void *)A
1488 #define TLOGICALVVVVVV( M,I,A,B,D) (void *)A
1489 #define TLOGICALVVVVVVV(M,I,A,B,D) (void *)A
1490 #define TLONGVV( M,I,A,B,D) (void *)A
1491 #define TLONGVVV( M,I,A,B,D) (void *)A
1492 #define TLONGVVVV( M,I,A,B,D) (void *)A
1493 #define TLONGVVVVV( M,I,A,B,D) (void *)A
1494 #define TLONGVVVVVV( M,I,A,B,D) (void *)A
1495 #define TLONGVVVVVVV( M,I,A,B,D) (void *)A
1496 #define TSHORTVV( M,I,A,B,D) (void *)A
1497 #define TSHORTVVV( M,I,A,B,D) (void *)A
1498 #define TSHORTVVVV( M,I,A,B,D) (void *)A
1499 #define TSHORTVVVVV( M,I,A,B,D) (void *)A
1500 #define TSHORTVVVVVV( M,I,A,B,D) (void *)A
1501 #define TSHORTVVVVVVV( M,I,A,B,D) (void *)A
1502 #define TPBYTE( M,I,A,B,D) A
1503 #define TPDOUBLE( M,I,A,B,D) A
1504 #define TPFLOAT( M,I,A,B,D) VOIDP0 A
1505 #define TPINT( M,I,A,B,D) A
1506 #define TPLOGICAL( M,I,A,B,D) ((*A=F2CLOGICAL(*A)),A)
1507 #define TPLONG( M,I,A,B,D) A
1508 #define TPSHORT( M,I,A,B,D) A
1509 #define TPVOID( M,I,A,B,D) A
1510 #define TROUTINE( M,I,A,B,D) ROUTINE_##I A
1511 /* A == pointer to the characters
1512  D == length of the string, or of an element in an array of strings
1513  E == number of elements in an array of strings */
1514 #define TTSTR( A,B,D) \
1515  ((B=malloc(D+1))[D]='\0', memcpy(B,A,D), kill_trailing(B,' '))
1516 #define TTTTSTR( A,B,D) (!(D<4||A[0]||A[1]||A[2]||A[3]))?NULL: \
1517  memchr(A,'\0',D) ?A : TTSTR(A,B,D)
1518 #define TTTTSTRV( A,B,D,E) (B##N=E,B=malloc(B##N*(D+1)), (void *) \
1519  vkill_trailing(f2cstrv(A,B,D+1, B##N*(D+1)), D+1,B##N*(D+1),' '))
1520 #ifdef vmsFortran
1521 #define TSTRING( M,I,A,B,D) TTTTSTR( A->dsc$a_pointer,B,A->dsc$w_length)
1522 #define TSTRINGV( M,I,A,B,D) TTTTSTRV(A->dsc$a_pointer, B, \
1523  A->dsc$w_length , A->dsc$l_m[0])
1524 #define TPSTRING( M,I,A,B,D) TTSTR( A->dsc$a_pointer,B,A->dsc$w_length)
1525 #define TPPSTRING( M,I,A,B,D) A->dsc$a_pointer
1526 #define TSTRVOID( M,I,A,B,D) A->dsc$a_pointer,A->dsc$w_length
1527 #else
1528 #ifdef CRAYFortran
1529 #define TSTRING( M,I,A,B,D) TTTTSTR( _fcdtocp(A),B,_fcdlen(A))
1530 #define TSTRINGV( M,I,A,B,D) TTTTSTRV(_fcdtocp(A),B,_fcdlen(A), \
1531  num_elem(_fcdtocp(A),_fcdlen(A),M##_STRV_##A))
1532 #define TPSTRING( M,I,A,B,D) TTSTR( _fcdtocp(A),B,_fcdlen(A))
1533 #define TPPSTRING( M,I,A,B,D) _fcdtocp(A)
1534 #define TSTRVOID( M,I,A,B,D) _fcdtocp(A),_fcdlen(A)
1535 #else
1536 #define TSTRING( M,I,A,B,D) TTTTSTR( A,B,D)
1537 #define TSTRINGV( M,I,A,B,D) TTTTSTRV(A,B,D, \
1538  num_elem(A,D,M##_STRV_##A))
1539 #define TPSTRING( M,I,A,B,D) TTSTR( A,B,D)
1540 #define TPPSTRING( M,I,A,B,D) A
1541 #define TSTRVOID( M,I,A,B,D) A,D
1542 #endif
1543 #endif
1544 #define TPNSTRING TSTRING
1545 #define TPSTRINGV TSTRINGV
1546 #define TCF_0( M,I,A,B,D)
1547 
1548 #define RCF(TN,I) STR_##TN(3,R,A##I,B##I,C##I,0)
1549 #define RLOGICAL( A,B,D)
1550 #define RPLOGICAL(A,B,D) *A=C2FLOGICAL(*A);
1551 #define RSTRING( A,B,D) if (B) free(B);
1552 #define RSTRINGV( A,B,D) free(B);
1553 /* A and D as defined above for TSTRING(V) */
1554 #define RRRRPSTR( A,B,D) if (B) memcpy(A,B,PGSMIN(strlen(B),D)), \
1555  (D>strlen(B)?memset(A+strlen(B),' ', D-strlen(B)):0), free(B);
1556 #define RRRRPSTRV(A,B,D) c2fstrv(B,A,D+1,(D+1)*B##N), free(B);
1557 #ifdef vmsFortran
1558 #define RPSTRING( A,B,D) RRRRPSTR( A->dsc$a_pointer,B,A->dsc$w_length)
1559 #define RPSTRINGV(A,B,D) RRRRPSTRV(A->dsc$a_pointer,B,A->dsc$w_length)
1560 #else
1561 #ifdef CRAYFortran
1562 #define RPSTRING( A,B,D) RRRRPSTR( _fcdtocp(A),B,_fcdlen(A))
1563 #define RPSTRINGV(A,B,D) RRRRPSTRV(_fcdtocp(A),B,_fcdlen(A))
1564 #else
1565 #define RPSTRING( A,B,D) RRRRPSTR( A,B,D)
1566 #define RPSTRINGV(A,B,D) RRRRPSTRV(A,B,D)
1567 #endif
1568 #endif
1569 #define RPNSTRING(A,B,D) RPSTRING( A,B,D)
1570 #define RPPSTRING(A,B,D)
1571 #define RSTRVOID( A,B,D)
1572 
1573 #define FZBYTE( UN,LN) INTEGER_BYTE fcallsc(UN,LN)(
1574 #define FZDOUBLE( UN,LN) DOUBLE_PRECISION fcallsc(UN,LN)(
1575 #define FZINT( UN,LN) int fcallsc(UN,LN)(
1576 #define FZLOGICAL(UN,LN) int fcallsc(UN,LN)(
1577 #define FZLONG( UN,LN) long fcallsc(UN,LN)(
1578 #define FZSHORT( UN,LN) short fcallsc(UN,LN)(
1579 #define FZVOID( UN,LN) void fcallsc(UN,LN)(
1580 #ifndef __CF__KnR
1581 /* The void is req'd by the Apollo, to make this an ANSI function declaration.
1582  The Apollo promotes K&R float functions to double. */
1583 #define FZFLOAT( UN,LN) float fcallsc(UN,LN)(void
1584 #ifdef vmsFortran
1585 #define FZSTRING( UN,LN) void fcallsc(UN,LN)(fstring *AS
1586 #else
1587 #ifdef CRAYFortran
1588 #define FZSTRING( UN,LN) void fcallsc(UN,LN)(_fcd AS
1589 #else
1590 #define FZSTRING( UN,LN) void fcallsc(UN,LN)(char *AS, unsigned D0
1591 #endif
1592 #endif
1593 #else
1594 #ifndef sunFortran
1595 #define FZFLOAT( UN,LN) float fcallsc(UN,LN)(
1596 #else
1597 #define FZFLOAT( UN,LN) FLOATFUNCTIONTYPE fcallsc(UN,LN)(
1598 #endif
1599 #if defined(vmsFortran) || defined(CRAYFortran)
1600 #define FZSTRING( UN,LN) void fcallsc(UN,LN)(AS
1601 #else
1602 #define FZSTRING( UN,LN) void fcallsc(UN,LN)(AS, D0
1603 #endif
1604 #endif
1605 
1606 #define FBYTE FZBYTE
1607 #define FDOUBLE FZDOUBLE
1608 #ifndef __CF_KnR
1609 #define FFLOAT( UN,LN) float fcallsc(UN,LN)(
1610 #else
1611 #define FFLOAT FZFLOAT
1612 #endif
1613 #define FINT FZINT
1614 #define FLOGICAL FZLOGICAL
1615 #define FLONG FZLONG
1616 #define FSHORT FZSHORT
1617 #define FVOID FZVOID
1618 #define FSTRING( UN,LN) FZSTRING(UN,LN),
1619 
1620 #define FFINT
1621 #define FFVOID
1622 #ifdef vmsFortran
1623 #define FFSTRING fstring *AS;
1624 #else
1625 #ifdef CRAYFortran
1626 #define FFSTRING _fcd AS;
1627 #else
1628 #define FFSTRING char *AS; unsigned D0;
1629 #endif
1630 #endif
1631 
1632 #define LLINT A0=
1633 #define LLSTRING A0=
1634 #define LLVOID
1635 
1636 #define KINT
1637 #define KVOID
1638 /* KSTRING copies the string into the position provided by the caller. */
1639 #ifdef vmsFortran
1640 #define KSTRING \
1641  memcpy(AS->dsc$a_pointer,A0, PGSMIN(AS->dsc$w_length,(A0==NULL?0:strlen(A0))) ); \
1642  AS->dsc$w_length>(A0==NULL?0:strlen(A0))? \
1643  memset(AS->dsc$a_pointer+(A0==NULL?0:strlen(A0)),' ', \
1644  AS->dsc$w_length-(A0==NULL?0:strlen(A0))):0;
1645 #else
1646 #ifdef CRAYFortran
1647 #define KSTRING \
1648  memcpy(_fcdtocp(AS),A0, PGSMIN(_fcdlen(AS),(A0==NULL?0:strlen(A0))) ); \
1649  _fcdlen(AS)>(A0==NULL?0:strlen(A0))? \
1650  memset(_fcdtocp(AS)+(A0==NULL?0:strlen(A0)),' ', \
1651  _fcdlen(AS)-(A0==NULL?0:strlen(A0))):0;
1652 #else
1653 #define KSTRING memcpy(AS,A0, PGSMIN(D0,(A0==NULL?0:strlen(A0))) ); \
1654  D0>(A0==NULL?0:strlen(A0))?memset(AS+(A0==NULL?0:strlen(A0)), \
1655  ' ', D0-(A0==NULL?0:strlen(A0))):0;
1656 #endif
1657 #endif
1658 
1659 /* Note that K.. and I.. can't be combined since K.. has to access data before
1660 R.., in order for functions returning strings which are also passed in as
1661 arguments to work correctly. Note that R.. frees and hence may corrupt the
1662 string. */
1663 #define IBYTE return A0;
1664 #define IDOUBLE return A0;
1665 #ifndef sunFortran
1666 #define IFLOAT return A0;
1667 #else
1668 #define IFLOAT RETURNFLOAT(A0);
1669 #endif
1670 #define IINT return A0;
1671 #define ILOGICAL return C2FLOGICAL(A0);
1672 #define ILONG return A0;
1673 #define ISHORT return A0;
1674 #define ISTRING return ;
1675 #define IVOID return ;
1676 
1677 #ifdef OLD_VAXC /* Allow %CC-I-PARAMNOTUSED. */
1678 #pragma standard
1679 #endif
1680 
1681 #define FCALLSCSUB0( CN,UN,LN) FCALLSCFUN0(VOID,CN,UN,LN)
1682 #define FCALLSCSUB1( CN,UN,LN,T1) FCALLSCFUN1(VOID,CN,UN,LN,T1)
1683 #define FCALLSCSUB2( CN,UN,LN,T1,T2) FCALLSCFUN2(VOID,CN,UN,LN,T1,T2)
1684 #define FCALLSCSUB3( CN,UN,LN,T1,T2,T3) FCALLSCFUN3(VOID,CN,UN,LN,T1,T2,T3)
1685 #define FCALLSCSUB4( CN,UN,LN,T1,T2,T3,T4) FCALLSCFUN4(VOID,CN,UN,LN,T1,T2,T3,T4)
1686 #define FCALLSCSUB5( CN,UN,LN,T1,T2,T3,T4,T5) \
1687  FCALLSCFUN5(VOID,CN,UN,LN,T1,T2,T3,T4,T5)
1688 #define FCALLSCSUB6( CN,UN,LN,T1,T2,T3,T4,T5,T6) \
1689  FCALLSCFUN6(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6)
1690 #define FCALLSCSUB7( CN,UN,LN,T1,T2,T3,T4,T5,T6,T7) \
1691  FCALLSCFUN7(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7)
1692 #define FCALLSCSUB8( CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \
1693  FCALLSCFUN8(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8)
1694 #define FCALLSCSUB9( CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \
1695  FCALLSCFUN9(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9)
1696 #define FCALLSCSUB10(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \
1697  FCALLSCFUN10(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA)
1698 #define FCALLSCSUB11(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \
1699  FCALLSCFUN11(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB)
1700 #define FCALLSCSUB12(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \
1701  FCALLSCFUN12(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC)
1702 #define FCALLSCSUB13(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \
1703  FCALLSCFUN13(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD)
1704 #define FCALLSCSUB14(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
1705  FCALLSCFUN14(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
1706 #define FCALLSCSUB15(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF) \
1707  FCALLSCFUN15(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF)
1708 
1709 #define FCALLSCFUN1( T0,CN,UN,LN,T1) \
1710  FCALLSCFUN5 (T0,CN,UN,LN,T1,CF_0,CF_0,CF_0,CF_0)
1711 #define FCALLSCFUN2( T0,CN,UN,LN,T1,T2) \
1712  FCALLSCFUN5 (T0,CN,UN,LN,T1,T2,CF_0,CF_0,CF_0)
1713 #define FCALLSCFUN3( T0,CN,UN,LN,T1,T2,T3) \
1714  FCALLSCFUN5 (T0,CN,UN,LN,T1,T2,T3,CF_0,CF_0)
1715 #define FCALLSCFUN4( T0,CN,UN,LN,T1,T2,T3,T4) \
1716  FCALLSCFUN5 (T0,CN,UN,LN,T1,T2,T3,T4,CF_0)
1717 #define FCALLSCFUN5( T0,CN,UN,LN,T1,T2,T3,T4,T5)\
1718  FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0)
1719 #define FCALLSCFUN6( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6) \
1720  FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0)
1721 #define FCALLSCFUN7( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7) \
1722  FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0)
1723 #define FCALLSCFUN8( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \
1724  FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0)
1725 #define FCALLSCFUN9( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \
1726  FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0)
1727 #define FCALLSCFUN10( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \
1728  FCALLSCFUN15(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0,CF_0)
1729 #define FCALLSCFUN11( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \
1730  FCALLSCFUN15(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0,CF_0)
1731 #define FCALLSCFUN12( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \
1732  FCALLSCFUN15(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0,CF_0)
1733 #define FCALLSCFUN13( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \
1734  FCALLSCFUN15(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0,CF_0)
1735 #define FCALLSCFUN14( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
1736  FCALLSCFUN15(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,CF_0)
1737 
1738 #ifndef __CF__KnR
1739 #define FCALLSCFUN0(T0,CN,UN,LN) \
1740 FZ##T0(UN,LN)) {_INT(2,UU,T0,A0,0); _INT(0,LL,T0,0,0) CN(); _INT(0,K,T0,0,0) I##T0}
1741 
1742 #define FCALLSCFUN15(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF) \
1743 F##T0(UN,LN) NCF(T1,1,0) NCF(T2,2,1) NCF(T3,3,1) NCF(T4,4,1) NCF(T5,5,1) \
1744  NCF(T6,6,1) NCF(T7,7,1) NCF(T8,8,1) NCF(T9,9,1) NCF(TA,A,1) \
1745  NCF(TB,B,1) NCF(TC,C,1) NCF(TD,D,1) NCF(TE,E,1) NCF(TF,F,1) \
1746  DCF(T1,1) DCF(T2,2) DCF(T3,3) DCF(T4,4) DCF(T5,5) \
1747  DCF(T6,6) DCF(T7,7) DCF(T8,8) DCF(T9,9) DCF(TA,A) \
1748  DCF(TB,B) DCF(TC,C) DCF(TD,D) DCF(TE,E) DCF(TF,F) ) \
1749  {QCF(T1,1) QCF(T2,2) QCF(T3,3) QCF(T4,4) QCF(T5,5) \
1750  QCF(T6,6) QCF(T7,7) QCF(T8,8) QCF(T9,9) QCF(TA,A) \
1751  QCF(TB,B) QCF(TC,C) QCF(TD,D) QCF(TE,E) QCF(TF,F) _INT(2,UU,T0,A0,0); \
1752  _INT(0,LL,T0,0,0) CN(TCF(LN,T1,1,0) TCF(LN,T2,2,1) TCF(LN,T3,3,1) TCF(LN,T4,4,1) \
1753  TCF(LN,T5,5,1) TCF(LN,T6,6,1) TCF(LN,T7,7,1) TCF(LN,T8,8,1) TCF(LN,T9,9,1) \
1754  TCF(LN,TA,A,1) TCF(LN,TB,B,1) TCF(LN,TC,C,1) TCF(LN,TD,D,1) TCF(LN,TE,E,1) TCF(LN,TF,F,1)); \
1755  _INT(0,K,T0,0,0) RCF(T1,1) RCF(T2,2) RCF(T3,3) RCF(T4,4) \
1756  RCF(T5,5) RCF(T6,6) RCF(T7,7) RCF(T8,8) RCF(T9,9) RCF(TA,A) \
1757  RCF(TB,B) RCF(TC,C) RCF(TD,D) RCF(TE,E) RCF(TF,F) I##T0}
1758 
1759 #else
1760 #define FCALLSCFUN0(T0,CN,UN,LN) FZ##T0(UN,LN)) _INT(0,FF,T0,0,0) \
1761 {_INT(2,UU,T0,A0,0); _INT(0,LL,T0,0,0) CN(); _INT(0,K,T0,0,0) I##T0}
1762 
1763 #define FCALLSCFUN15(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF) \
1764 F##T0(UN,LN) NNCF(T1,1,0) NNCF(T2,2,1) NNCF(T3,3,1) NNCF(T4,4,1) NNCF(T5,5,1)\
1765  NNCF(T6,6,1) NNCF(T7,7,1) NNCF(T8,8,1) NNCF(T9,9,1) \
1766  NNCF(TA,A,1) NNCF(TB,B,1) NNCF(TC,C,1) NNCF(TD,D,1) NNCF(TE,E,1) NNCF(TF,F,1) \
1767  DDCF(T1,1) DDCF(T2,2) DDCF(T3,3) DDCF(T4,4) DDCF(T5,5) \
1768  DDCF(T6,6) DDCF(T7,7) DDCF(T8,8) DDCF(T9,9) \
1769  DDCF(TA,A) DDCF(TB,B) DDCF(TC,C) DDCF(TD,D) DDCF(TE,E) DDCF(TF,F)) _INT(0,FF,T0,0,0) \
1770  NNNCF(T1,1,0) NNNCF(T2,2,1) NNNCF(T3,3,1) NNNCF(T4,4,1) NNNCF(T5,5,1) \
1771  NNNCF(T6,6,1) NNNCF(T7,7,1) NNNCF(T8,8,1) NNNCF(T9,9,1) \
1772  NNNCF(TA,A,1) NNNCF(TB,B,1) NNNCF(TC,C,1) NNNCF(TD,D,1) NNNCF(TE,E,1) NNNCF(TF,F,1) \
1773  DDDCF(T1,1) DDDCF(T2,2) DDDCF(T3,3) DDDCF(T4,4) DDDCF(T5,5) \
1774  DDDCF(T6,6) DDDCF(T7,7) DDDCF(T8,8) DDDCF(T9,9) \
1775  DDDCF(TA,A) DDDCF(TB,B) DDDCF(TC,C) DDDCF(TD,D) DDDCF(TE,E) DDDCF(TF,F); \
1776  {QCF(T1,1) QCF(T2,2) QCF(T3,3) QCF(T4,4) QCF(T5,5) \
1777  QCF(T6,6) QCF(T7,7) QCF(T8,8) QCF(T9,9) \
1778  QCF(TA,A) QCF(TB,B) QCF(TC,C) QCF(TD,D) QCF(TE,E) QCF(TF,F) _INT(2,UU,T0,A0,0); \
1779  _INT(0,LL,T0,0,0) CN( TCF(LN,T1,1,0) TCF(LN,T2,2,1) TCF(LN,T3,3,1) \
1780  TCF(LN,T4,4,1) TCF(LN,T5,5,1) TCF(LN,T6,6,1) \
1781  TCF(LN,T7,7,1) TCF(LN,T8,8,1) TCF(LN,T9,9,1) \
1782  TCF(LN,TA,A,1) TCF(LN,TB,B,1) TCF(LN,TC,C,1) TCF(LN,TD,D,1) TCF(LN,TE,E,1) TCF(LN,TF,F,1)); \
1783  _INT(0,K,T0,0,0) RCF(T1,1) RCF(T2,2) RCF(T3,3) RCF(T4,4) RCF(T5,5) \
1784  RCF(T6,6) RCF(T7,7) RCF(T8,8) RCF(T9,9) \
1785  RCF(TA,A) RCF(TB,B) RCF(TC,C) RCF(TD,D) RCF(TE,E) RCF(TF,F) I##T0}
1786 
1787 #endif
1788 
1789 #endif /* VAX VMS or Ultrix, Mips, CRAY, Sun, Apollo, HP9000, LynxOS, IBMR2.
1790  f2c, NAG f90. */
1791 
1792 
1793 #ifdef __cplusplus
1794 }
1795 #endif
1796 
1797 
1798 
1799 
1800 
kill_trailingn
static char * kill_trailingn(char *s, char t, char *e)
Definition: cfortHdf.h:327
__cfztringv
static int __cfztringv[30]
Definition: cfortHdf.h:443
_NUM_ELEMS
#define _NUM_ELEMS
Definition: cfortHdf.h:378
c2fstrv
static char * c2fstrv(char *cstr, char *fstr, int elem_len, int sizeofcstr)
Definition: cfortHdf.h:278
kill_trailing
static char * kill_trailing(char *s, char t)
Definition: cfortHdf.h:311
num
HDFFCLIBAPI intf intf intf * num
Definition: hproto_fortran.h:583
_NUM_ELEM_ARG
#define _NUM_ELEM_ARG
Definition: cfortHdf.h:379
num_elem
static int num_elem(char *strv, unsigned elem_len, int term_char, int num_term)
Definition: cfortHdf.h:384
vkill_trailing
static char * vkill_trailing(char *cstr, int elem_len, int sizeofcstr, char t)
Definition: cfortHdf.h:341
f2cstrv
static char * f2cstrv(char *fstr, char *cstr, int elem_len, int sizeofcstr)
Definition: cfortHdf.h:294
MISR Toolkit - Copyright © 2005 - 2020 Jet Propulsion Laboratory
Generated on Fri Jun 19 2020 22:49:52