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