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

© 2012

R.E. Hewitt