-
Notifications
You must be signed in to change notification settings - Fork 6
/
cfortran.h
2389 lines (2203 loc) · 128 KB
/
cfortran.h
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
/* cfortran.h 20220815 */
/* http://www-zeus.desy.de/~burow/cfortran/ */
/* Burkhard Burow burow@desy.de 1990 - 2002. */
/*
THIS FILE IS PROPERTY OF BURKHARD BUROW. IF YOU ARE USING THIS FILE YOU
SHOULD ALSO HAVE ACCESS TO CFORTRAN.DOC WHICH PROVIDES TERMS FOR USING,
MODIFYING, COPYING AND DISTRIBUTING THE CFORTRAN.H PACKAGE.
THIS PACKAGE, I.E. CFORTRAN.H, THIS DOCUMENT, AND THE CFORTRAN.H EXAMPLE
PROGRAMS ARE PROPERTY OF THE AUTHOR WHO RESERVES ALL RIGHTS. THIS PACKAGE AND
THE CODE IT PRODUCES MAY BE FREELY DISTRIBUTED WITHOUT FEES, SUBJECT
(AT YOUR CHOICE) EITHER TO THE GNU LIBRARY GENERAL PUBLIC LICENSE
AT http://www.gnu.org/licenses/lgpl.html OR TO THE FOLLOWING RESTRICTIONS:
- YOU MUST ACCOMPANY ANY COPIES OR DISTRIBUTION WITH THIS (UNALTERED) NOTICE.
- YOU MAY NOT RECEIVE MONEY FOR THE DISTRIBUTION OR FOR ITS MEDIA
(E.G. TAPE, DISK, COMPUTER, PAPER.)
- YOU MAY NOT PREVENT OTHERS FROM COPYING IT FREELY.
- YOU MAY NOT DISTRIBUTE MODIFIED VERSIONS WITHOUT CLEARLY DOCUMENTING YOUR
CHANGES AND NOTIFYING THE AUTHOR.
- YOU MAY NOT MISREPRESENTED THE ORIGIN OF THIS SOFTWARE, EITHER BY EXPLICIT
CLAIM OR BY OMISSION.
THE INTENT OF THE ABOVE TERMS IS TO ENSURE THAT THE CFORTRAN.H PACKAGE NOT BE
USED FOR PROFIT MAKING ACTIVITIES UNLESS SOME ROYALTY ARRANGEMENT IS ENTERED
INTO WITH ITS AUTHOR.
THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
EXPRESSED OR IMPLIED. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST
OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. THE AUTHOR IS NOT RESPONSIBLE
FOR ANY SUPPORT OR SERVICE OF THE CFORTRAN.H PACKAGE.
Burkhard Burow
burow@desy.de
*/
/*
This is a merged version of the modifications by the Debian project,
the CFITSIO package: https://heasarc.gsfc.nasa.gov/fitsio/
and Bastien ROUCARIES: https://github.com/bastien-roucaries/cfortran
version 4.4.1 downloaded from
https://gitlab.astro.unige.ch/ferrigno/timingsuite
from Matthias Cuntz (MC)
version 20210827 downloaded from
https://github.com/bastien-roucaries/cfortran
on 2022-08-01
Copyright (C) 2011 Bastien ROUCARIES (BR)
new version downloaded from cfitsio v4.1.0 (Mar 2022)
https://heasarc.gsfc.nasa.gov/fitsio/
on 2022-08-15
*/
/*
The following modifications were made by the authors of CFITSIO or by me,
i.e. Kevin McCarty. They are flagged below with CFITSIO, the author's initials,
or KMCCARTY.
* PDW = Peter Wilson
* DM = Doug Mink
* LEB = Lee E Brotzman
* MR = Martin Reinecke
* WDP = William D Pence
* -- Kevin McCarty, for Debian (19 Dec. 2005)
Modifications:
Oct 1997 Changed symbol name extname to appendus (PDW/HSTX)
(Conflicted with a common variable name in FTOOLS)
Nov 1997 If g77Fortran defined, also define f2cFortran (PDW/HSTX)
Feb 1998 Let VMS see the NUM_ELEMS code. Lets programs treat
single strings as vectors with single elements
Nov 1999 If macintoxh defined, also define f2cfortran (for Mac OS-X)
Apr 2000 If WIN32 defined, also define PowerStationFortran and
VISUAL_CPLUSPLUS (Visual C++)
Jun 2000 If __GNUC__ and linux defined, also define f2cFortran
(linux/gcc environment detection)
Apr 2002 If __CYGWIN__ is defined, also define f2cFortran
Nov 2002 If __APPLE__ defined, also define f2cfortran (for Mac OS-X)
Nov 2003 If __INTEL_COMPILER or INTEL_COMPILER defined, also define
f2cFortran (KMCCARTY)
Dec 2005 If f2cFortran is defined, enforce REAL functions in FORTRAN
returning "double" in C. This was one of the items on
Burkhard's TODO list. (KMCCARTY)
Dec 2005 Modifications to support 8-byte integers. (MR)
USE AT YOUR OWN RISK!
Feb 2006 Added logic to typedef the symbol 'LONGLONG' to an appropriate
intrinsic 8-byte integer datatype (WDP)
Apr 2006 Modifications to support gfortran (and g77 with -fno-f2c flag)
since by default it returns "float" for FORTRAN REAL function.
(KMCCARTY)
May 2008 Revert commenting out of "extern" in COMMON_BLOCK_DEF macro.
Add braces around do-nothing ";" in 3 empty while blocks to
get rid of compiler warnings. Thanks to ROOT developers
Jacek Holeczek and Rene Brun for these suggestions. (KMCCARTY)
Dec 2008 Added typedef for LONGLONG to support Borland compiler (WDP)
Jun 2011 (BR - 20110621)
Drop support of VAX (no release since 1995),
Drop apollo/DomainOS (not supported since 2001)
Drop K&R C support (dead since 1990)
May 2014 Added FreeBSD (MC)
Jan 2020 Added __attribute__((unused)) for GCC to prevent warnings (C. Markwardt)
Aug 2021 Drop CRAY support (BR - 20210827)
Jan 2022 Changed H_CF_SPECIAL definition from 'unsigned' to 'size_t'.
This determines the type of the hidden length argument which
gets added to functions passing strings from Fortran to C.
This change was first required when testing Homebrew
compilers native to Mac/ARM Silicon. (C. Gordon)
*/
/*
Avoid symbols already used by compilers and system *.h:
__ - OSF1 zukal06 V3.0 347 alpha, cc -c -std1 cfortest.c
*/
/*
Determine what 8-byte integer data type is available.
'long long' is now supported by most compilers, but older
MS Visual C++ compilers before V7.0 use '__int64' instead. (WDP)
*/
#ifndef __CFORTRAN_LOADED
#define __CFORTRAN_LOADED
/***********/
/* Version */
/***********/
#define CFORTRAN_VERSION 20210827UL
/*********************/
/* Obsolete bail out */
/*********************/
#if !(defined(__STDC__) || defined(__cplusplus))
#error "cfortran need an AINSI C Compiler"
#endif
#ifdef _MSC_VER
#if _MSC_VER >= 1200
#error "Need a least MS Visual > 6"
#endif
#endif
/********************/
/* type definition */
/********************/
#ifndef __CFORTRAN__PCTYPE__UNUSED__
#ifdef __GNUC__
#define __CFORTRAN__PCTYPE__UNUSED__ __attribute__ ((unused))
#else
#define __CFORTRAN__PCTYPE__UNUSED__
#endif
#endif
#if defined(_MSC_VER) /* Microsoft Visual C++ */
#if (_MSC_VER < 1300) /* versions earlier than V7.0 do not have 'long long' */
typedef __int64 CFORTRAN_LONGLONG;
typedef unsigned __int64 ULONGLONG;
#endif
#elif defined( __BORLANDC__) /* (WDP) for the free Borland compiler, in particular */
typedef __int64 CFORTRAN_LONGLONG;
typedef unsigned __int64 ULONGLONG;
#else
typedef long long CFORTRAN_LONGLONG;
typedef unsigned long long ULONGLONG;
#endif
/* Microsoft Visual C++ requires alternate form for static inline. */
#if defined(_MSC_VER) /* Microsoft Visual C++ */
#define STIN static __inline
#else
#define STIN static inline
#endif
/************/
/* Includes */
/************/
#include <stdio.h> /* NULL [in all machines stdio.h] */
#include <string.h> /* strlen, memset, memcpy, memchr. */
#include <stdlib.h> /* malloc,free */
/*********/
/* TOOLS */
/*********/
/*! Concatenate two string */
#define CFORTRAN_CAT_(A,B) A##B
/*! Well known xcat : concatenate after expansion */
#define CFORTRAN_XCAT_(A,B) CFORTRAN_CAT_(A,B)
/*! Concatenate two string */
#define CFORTRAN_CAT_2(A,B) A##B
/*! xcat but for three strings */
#define CFORTRAN_XCAT_3(A,B,C) CFORTRAN_XCAT_(A, CFORTRAN_XCAT_(B,C))
/* Remainder of cfortran.h depends on the Fortran compiler. */
/* 11/29/2003 (KMCCARTY): add *INTEL_COMPILER symbols here */
/* 04/05/2006 (KMCCARTY): add gFortran symbol here */
/* 05/2014 (MC): added symbols with double underscores for JAMS Fortran library */
#if defined(CLIPPERFortran) || defined(pgiFortran) || defined(__INTEL_COMPILER) || defined(INTEL_COMPILER) || defined(gFortran) || defined(__gFortran__) || defined(__GFORTRAN__) || defined(__pgiFortran__) || defined(__PGIFORTAN__) || defined(__INTEL__)
#define f2cFortran
#endif
#if defined(g77Fortran) /* 11/03/97 PDW (CFITSIO) */
#define f2cFortran
#endif
/*****************/
/* Need guessing */
/*****************/
/* Vms does not let us \-split long #if lines. */
/* Split #if into 2 because some HP-UX can't handle long #if */
/* 05/2014 (MC): added symbols with double underscores for JAMS Fortran library */
#if !(defined(NAGf90Fortran) || defined(__NAGf90Fortran__) || defined(f2cFortran) || defined(hpuxFortran) || defined(sunFortran) || defined(IBMR2Fortran) || defined(CRAYFortran))
#if !(defined(mipsFortran) || defined(DECFortran) || defined(vmsFortran) || defined(CONVEXFortran) || defined(PowerStationFortran))
#if !(defined(AbsoftUNIXFortran) || defined(AbsoftProFortran) || defined(SXFortran))
/* If no Fortran compiler is given, we choose one for the machines we know. */
/* warm if guess is difficult */
#if defined(__GNUC__)
#if __GNUC__ == 3
#warning "Please specify the fortran compiler using -D flags. Try to guess the compiler used"
#endif
#else
#if defined(WIN32) && !defined(__CYGWIN__)
#warning "Please specify the fortran compiler using -D flags. Try to guess the compiler used"
#endif
#endif
#define CFORTRAN_GUESS_COMPILER
#endif /* ... fortran */
#endif /* ... fortran */
#endif /* ... fortran */
/*******************/
/* Guess selection */
/*******************/
#if defined(CFORTRAN_GUESS_COMPILER)
/* Autodetect */
#if defined(lynx)
/* Lynx: Only support f2c at the moment.
Support f2c or f77 with gcc, vcc with f2c.
f77 with vcc works, missing link magic for f77 I/O.*/
#define f2cFortran
#endif
/* 04/13/00 DM (CFITSIO): Add these lines for NT */
/* with PowerStationFortran and and Visual C++ */
#if defined(WIN32) && ! defined(__CYGWIN__)
#define PowerStationFortran
#define VISUAL_CPLUSPLUS
#endif
#if defined(__CYGWIN__) /* 04/11/02 LEB (CFITSIO) */
#define f2cFortran
#define gFortran /* 8/26/08 (KMCCARTY) */
#endif
#if defined(__GNUC__) && defined(linux) /* 06/21/00 PDW (CFITSIO) */
#define f2cFortran
#define gFortran /* 8/26/08 (KMCCARTY) */
#endif
#if defined(macintosh) /* 11/1999 (CFITSIO) */
#define f2cFortran
#define gFortran /* 8/26/08 (KMCCARTY) */
#endif
#if defined(__APPLE__) /* 11/2002 (CFITSIO) */
#define f2cFortran
#define gFortran /* 8/26/08 (KMCCARTY) */
#endif
#if defined(__FreeBSD__) /* 05/2014 Mac OSX == FreeBSD (MC) */
#define f2cFortran
#define gFortran
#endif
#if defined(__hpux) /* 921107: Use __hpux instead of __hp9000s300 */
#define hpuxFortran /* Should also allow hp9000s7/800 use.*/
#endif
#if defined(sun) || defined(__sun)
#define sunFortran
#endif
#if defined(_IBMR2)
#define IBMR2Fortran
#endif
#if defined(_SX)
#define SXFortran
#endif
#if defined(mips) || defined(__mips)
#define mipsFortran
#endif
#if defined(vms) || defined(__vms)
#define vmsFortran
#endif
#if defined(__alpha) && defined(__unix__)
#define DECFortran
#endif
#if defined(__convex__)
#define CONVEXFortran
#endif
#if defined(VISUAL_CPLUSPLUS)
#define PowerStationFortran
#endif
#endif /* Guess compiler */
/********************************************/
/* Error if compiler not found or not given */
/********************************************/
/* Split #if into 2 because some HP-UX can't handle long #if */
/* 05/2014 (MC): added symbols with double underscores for JAMS Fortran library */
#if !(defined(NAGf90Fortran) || defined(__NAGf90Fortran__) || defined(f2cFortran) || defined(hpuxFortran) || defined(sunFortran) || defined(IBMR2Fortran) || defined(CRAYFortran))
#if !(defined(mipsFortran) || defined(DECFortran) || defined(vmsFortran) || defined(CONVEXFortran) || defined(PowerStationFortran))
#if !(defined(AbsoftUNIXFortran)||defined(AbsoftProFortran)||defined(SXFortran))
/* If your compiler barfs on ' #error', replace # with the trigraph for # */
#error "cfortran.h: Can't find your environment among:\
- GNU gcc (gfortran) on Linux. \
- MIPS cc and f77 2.0. (e.g. Silicon Graphics, DECstations, ...) \
- IBM AIX XL C and FORTRAN Compiler/6000 Version 01.01.0000.0000 \
- Alpha VMS DEC C 1.3 and DEC FORTRAN 6.0. \
- Alpha OSF DEC C and DEC Fortran for OSF/1 AXP Version 1.2 \
- CRAY \
- NEC SX-4 SUPER-UX \
- CONVEX \
- Sun \
- PowerStation Fortran with Visual C++ \
- HP9000s300/s700/s800 Latest test with: HP-UX A.08.07 A 9000/730 \
- LynxOS: cc or gcc with f2c. \
- f2c/g77: Use #define f2cFortran, or cc -Df2cFortran \
- gfortran: Use #define gFortran, or cc -DgFortran \
- or #define __gFortran__, or cc -D__gFortran__ \
(also necessary for g77 with -fno-f2c option) \
- NAG f90: Use #define NAGf90Fortran, or cc -DNAGf90Fortran \
or #define __NAGf90Fortran__, or cc -D__NAGf90Fortran__ \
- Absoft UNIX F77: Use #define AbsoftUNIXFortran or cc -DAbsoftUNIXFortran \
- Absoft Pro Fortran: Use #define AbsoftProFortran \
- Portland Group Fortran: Use #define pgiFortran \
- Intel Fortran: Use #define INTEL_COMPILER or #define __INTEL__"
/* Compiler must throw us out at this point! */
#endif
#endif
#endif
/* Throughout cfortran.h we use: UN = Uppercase Name. LN = Lowercase Name. */
/* "extname" changed to "appendus" below (CFITSIO) */
/* 05/2014 (MC): added symbols with double underscores for JAMS Fortran library */
#if defined(f2cFortran) || defined(NAGf90Fortran) || defined(__NAGf90Fortran__) || defined(DECFortran) || defined(mipsFortran) || defined(sunFortran) || defined(CONVEXFortran) || defined(SXFortran) || defined(appendus)
#define CFC_(UN,LN) CFORTRAN_XCAT_(LN,_) /* Lowercase FORTRAN symbols. */
#define orig_fcallsc(UN,LN) CFC_(UN,LN)
#else
#if defined(CRAYFortran) || defined(PowerStationFortran) || defined(AbsoftProFortran)
#define CFC_(UN,LN) UN /* Uppercase FORTRAN symbols. */
#define orig_fcallsc(UN,LN) CFC_(UN,LN) /* CRAY insists on arg.'s here. */
#else /* For following machines one may wish to change the fcallsc default. */
#define CF_SAME_NAMESPACE
#ifdef vmsFortran
#define CFC_(UN,LN) LN /* Either case FORTRAN symbols. */
/* BUT we usually use UN for C macro to FORTRAN routines, so use LN here,*/
/* because VMS doesn't do recursive macros. */
#define orig_fcallsc(UN,LN) UN
#else /* HP-UX without +ppu or IBMR2 without -qextname. NOT reccomended. */
#define CFC_(UN,LN) LN /* Lowercase FORTRAN symbols. */
#define orig_fcallsc(UN,LN) CFC_(UN,LN)
#endif /* vmsFortran */
#endif /* CRAYFortran PowerStationFortran */
#endif /* ....Fortran */
#define fcallsc(UN,LN) orig_fcallsc(UN,LN)
#define preface_fcallsc(P,p,UN,LN) CFC_( CFORTRAN_XCAT_(P,UN), CFORTRAN_XCAT_(p,LN))
#define append_fcallsc(P,p,UN,LN) CFC_( CFORTRAN_XCAT_(UN,P), CFORTRAN_XCAT_(LN,p))
#define C_FUNCTION(UN,LN) fcallsc(UN,LN)
#define FORTRAN_FUNCTION(UN,LN) CFC_(UN,LN)
#ifndef COMMON_BLOCK
#ifndef CONVEXFortran
#ifndef CLIPPERFortran
#if !(defined(AbsoftUNIXFortran)||defined(AbsoftProFortran))
#define COMMON_BLOCK(UN,LN) CFC_(UN,LN)
#else
#define COMMON_BLOCK(UN,LN) CFORTRAN_XCAT_(_C,LN)
#endif /* AbsoftUNIXFortran or AbsoftProFortran */
#else
#define COMMON_BLOCK(UN,LN) CFORTRAN_XCAT_(LN,__)
#endif /* CLIPPERFortran */
#else
#define COMMON_BLOCK(UN,LN) CFORTRAN_XCAT_3(_,LN,_)
#endif /* CONVEXFortran */
#endif /* COMMON_BLOCK */
#ifndef DOUBLE_PRECISION
#define DOUBLE_PRECISION double
#endif
#ifndef FORTRAN_REAL
#define FORTRAN_REAL float
#endif
#define FLOATVVVVVVV_cfPP
#define VOIDP
#ifdef vmsFortran
#if defined(vms) || defined(__vms)
#include <descrip.h>
#else
#include "descrip.h" /* i.e. if crosscompiling assume user has file. */
#endif
#endif
#ifdef sunFortran
#if defined(sun) || defined(__sun)
#include <math.h> /* Sun's FLOATFUNCTIONTYPE, ASSIGNFLOAT, RETURNFLOAT. */
#else
#include "math.h" /* i.e. if crosscompiling assume user has file. */
#endif
/* At least starting with the default C compiler SC3.0.1 of SunOS 5.3,
* FLOATFUNCTIONTYPE, ASSIGNFLOAT, RETURNFLOAT are not required and not in
* <math.h>, since sun C no longer promotes C float return values to doubles.
* Therefore, only use them if defined.
* Even if gcc is being used, assume that it exhibits the Sun C compiler
* behavior in order to be able to use *.o from the Sun C compiler.
* i.e. If FLOATFUNCTIONTYPE, etc. are in math.h, they required by gcc.
*/
#endif
#define COMMON_BLOCK_DEF(DEFINITION, NAME) extern DEFINITION NAME
#define CF_NULL_PROTO
#ifdef __cplusplus
#undef CF_NULL_PROTO
#define CF_NULL_PROTO ...
#endif
#ifndef USE_NEW_DELETE
#ifdef __cplusplus
#define USE_NEW_DELETE 1
#else
#define USE_NEW_DELETE 0
#endif
#endif
#if USE_NEW_DELETE
#define _cf_malloc(N) new char[N]
#define _cf_free(P) delete[] P
#else
#define _cf_malloc(N) (char *)malloc(N)
#define _cf_free(P) free(P)
#endif
#ifdef mipsFortran
#define CF_DECLARE_GETARG int f77argc; char **f77argv
#define CF_SET_GETARG(ARGC,ARGV) f77argc = ARGC; f77argv = ARGV
#else
#define CF_DECLARE_GETARG
#define CF_SET_GETARG(ARGC,ARGV)
#endif
#define AcfCOMMA ,
#define AcfCOLON ;
/*-------------------------------------------------------------------------*/
/* UTILITIES USED WITHIN CFORTRAN.H */
#define _cfMIN(A,B) (A<B?A:B)
/* 970211 - XIX.145:
firstindexlength - better name is all_but_last_index_lengths
secondindexlength - better name is last_index_length
*/
#define firstindexlength(A) (sizeof(A[0])==1 ? 1 : (sizeof(A) / sizeof(A[0])) )
#define secondindexlength(A) (sizeof(A[0])==1 ? sizeof(A) : sizeof(A[0]) )
/* Behavior of FORTRAN LOGICAL. All machines' LOGICAL is same size as C's int.
Conversion is automatic except for arrays which require F2CLOGICALV/C2FLOGICALV.
f2c, MIPS f77 [DECstation, SGI],
HP-UX f77 : as in C.
Absoft Unix Fortran, IBM RS/6000 xlf : LS Bit = 0/1 = TRUE/FALSE.
[DECFortran for Ultrix RISC is also called f77 but is the same as VMS.]
[MIPS f77 treats .eqv./.neqv. as .eq./.ne. and hence requires LOGICAL_STRICT.]*/
/* 05/2014 (MC): added symbols with double underscores for JAMS Fortran library */
#if defined(NAGf90Fortran) || defined(__NAGf90Fortran__) || defined(f2cFortran) || defined(mipsFortran) || defined(PowerStationFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran) || defined(AbsoftProFortran) || defined(SXFortran)
/* SX/PowerStationFortran have 0 and 1 defined, others are neither T nor F. */
/* hpuxFortran800 has 0 and 0x01000000 defined. Others are unknown. */
#define LOGICAL_STRICT /* Other Fortran have .eqv./.neqv. == .eq./.ne. */
#endif
#define C2FLOGICALV(A,I) \
do {int __i; for(__i=0;__i<I;__i++) A[__i]=C2FLOGICAL(A[__i]); } while (0)
#define F2CLOGICALV(A,I) \
do {int __i; for(__i=0;__i<I;__i++) A[__i]=F2CLOGICAL(A[__i]); } while (0)
#if defined(IBMR2Fortran) || defined(vmsFortran) || defined(DECFortran) || defined(AbsoftUNIXFortran)
/* How come no AbsoftProFortran ? */
#define C2FLOGICAL(L) ((L)?(L)|1:(L)&~(int)1)
#define F2CLOGICAL(L) ((L)&1?(L):0)
#else
#if defined(CONVEXFortran)
#define C2FLOGICAL(L) ((L) ? ~0 : 0 )
#define F2CLOGICAL(L) (L)
#else /* others evaluate LOGICALs as for C. */
#define C2FLOGICAL(L) (L)
#define F2CLOGICAL(L) (L)
#ifndef LOGICAL_STRICT
#undef C2FLOGICALV
#undef F2CLOGICALV
#define C2FLOGICALV(A,I)
#define F2CLOGICALV(A,I)
#endif /* LOGICAL_STRICT */
#endif /* CONVEXFortran || All Others */
#endif /* IBMR2Fortran vmsFortran DECFortran AbsoftUNIXFortran */
/* 970514 - In addition to CRAY, there may be other machines
for which LOGICAL_STRICT makes no sense. */
#if defined(LOGICAL_STRICT) && !defined(CRAYFortran)
/* Force C2FLOGICAL to generate only the values for either .TRUE. or .FALSE.
SX/PowerStationFortran only have 0 and 1 defined.
Elsewhere, only needed if you want to do:
logical lvariable
if (lvariable .eq. .true.) then ! (1)
instead of
if (lvariable .eqv. .true.) then ! (2)
- You pay a (slight) performance penalty for using LOGICAL_STRICT. */
#undef C2FLOGICAL
#ifdef hpuxFortran800
#define C2FLOGICAL(L) ((L)?0x01000000:0)
#else
#if defined(vmsFortran) || defined(DECFortran)
#define C2FLOGICAL(L) ((L)?-1:0) /* These machines use -1/0 for .true./.false.*/
#else
#define C2FLOGICAL(L) ((L)? 1:0) /* All others use +1/0 for .true./.false.*/
#endif
#endif
#endif /* LOGICAL_STRICT */
/* Convert a vector of C strings into FORTRAN strings. */
static char *c2fstrv(char* cstr, char *fstr, int elem_len, int sizeofcstr)
{ int i,j;
/* elem_len includes \0 for C strings. Fortran strings don't have term. \0.
Useful size of string must be the same in both languages. */
for (i=0; i<sizeofcstr/elem_len; i++) {
for (j=1; j<elem_len && *cstr; j++) *fstr++ = *cstr++;
cstr += 1+elem_len-j;
for (; j<elem_len; j++) *fstr++ = ' ';
} /* 95109 - Seems to be returning the original fstr. */
return fstr-sizeofcstr+sizeofcstr/elem_len; }
/* Convert a vector of FORTRAN strings into C strings. */
static char *f2cstrv(char *fstr, char* cstr, int elem_len, int sizeofcstr)
{ int i,j;
/* elem_len includes \0 for C strings. Fortran strings don't have term. \0.
Useful size of string must be the same in both languages. */
cstr += sizeofcstr;
fstr += sizeofcstr - sizeofcstr/elem_len;
for (i=0; i<sizeofcstr/elem_len; i++) {
*--cstr = '\0';
for (j=1; j<elem_len; j++) *--cstr = *--fstr;
} return cstr; }
/* kill the trailing char t's in string s. */
static char *kill_trailing(char *s, char t)
{char *e;
e = s + strlen(s);
if (e>s) { /* Need this to handle NULL string.*/
while (e>s && *--e==t) {;} /* Don't follow t's past beginning. */
e[*e==t?0:1] = '\0'; /* Handle s[0]=t correctly. */
} return s; }
/* kill_trailingn(s,t,e) will kill the trailing t's in string s. e normally
points to the terminating '\0' of s, but may actually point to anywhere in s.
s's new '\0' will be placed at e or earlier in order to remove any trailing t's.
If e<s string s is left unchanged. */
static char *kill_trailingn(char *s, char t, char *e)
{
if (e==s) *e = '\0'; /* Kill the string makes sense here.*/
else if (e>s) { /* Watch out for neg. length string.*/
while (e>s && *--e==t){;} /* Don't follow t's past beginning. */
e[*e==t?0:1] = '\0'; /* Handle s[0]=t correctly. */
} return s; }
/* Note the following assumes that any element which has t's to be chopped off,
does indeed fill the entire element. */
static char *vkill_trailing(char* cstr, int elem_len, int sizeofcstr, char t)
{ int i;
for (i=0; i<sizeofcstr/elem_len; i++) /* elem_len includes \0 for C strings. */
kill_trailingn(cstr+elem_len*i,t,cstr+elem_len*(i+1)-1);
return cstr; }
#ifdef vmsFortran
typedef struct dsc$descriptor_s fstring;
#define DSC$DESCRIPTOR_A(DIMCT) \
struct { \
unsigned short dsc$w_length; unsigned char dsc$b_dtype; \
unsigned char dsc$b_class; char *dsc$a_pointer; \
char dsc$b_scale; unsigned char dsc$b_digits; \
struct { \
unsigned : 3; unsigned dsc$v_fl_binscale : 1; \
unsigned dsc$v_fl_redim : 1; unsigned dsc$v_fl_column : 1; \
unsigned dsc$v_fl_coeff : 1; unsigned dsc$v_fl_bounds : 1; \
} dsc$b_aflags; \
unsigned char dsc$b_dimct; unsigned long dsc$l_arsize; \
char *dsc$a_a0; long dsc$l_m [DIMCT]; \
struct { \
long dsc$l_l; long dsc$l_u; \
} dsc$bounds [DIMCT]; \
}
typedef DSC$DESCRIPTOR_A(1) fstringvector;
/*typedef DSC$DESCRIPTOR_A(2) fstringarrarr;
typedef DSC$DESCRIPTOR_A(3) fstringarrarrarr;*/
#define initfstr(F,C,ELEMNO,ELEMLEN) \
( (F).dsc$l_arsize= ( (F).dsc$w_length =(ELEMLEN) ) \
*( (F).dsc$l_m[0]=(F).dsc$bounds[0].dsc$l_u=(ELEMNO) ), \
(F).dsc$a_a0 = ( (F).dsc$a_pointer=(C) ) - (F).dsc$w_length ,(F))
#endif /* PDW: 2/10/98 (CFITSIO) -- Let VMS see NUM_ELEMS definitions */
#define _NUM_ELEMS -1
#define _NUM_ELEM_ARG -2
#define NUM_ELEMS(A) A,_NUM_ELEMS
#define NUM_ELEM_ARG(B) *CFORTRAN_CAT_2(A,B),_NUM_ELEM_ARG
#define TERM_CHARS(A,B) A,B
/* 08/2022 (MC): next line and function __cfortran__notused_dummy deleted in 4.4.1
keep it for easier understanding */
static void __cfortran__notused_dummy();
STIN int num_elem(char *strv, unsigned elem_len, int term_char, int num_term)
/* elem_len is the number of characters in each element of strv, the FORTRAN
vector of strings. The last element of the vector must begin with at least
num_term term_char characters, so that this routine can determine how
many elements are in the vector. */
{
unsigned num,i;
if (num_term == _NUM_ELEMS || num_term == _NUM_ELEM_ARG)
return term_char;
if (num_term <=0) num_term = (int)elem_len;
for (num=0; ; num++) {
for (i=0; i<(unsigned)num_term && *strv==term_char; i++,strv++){;}
if (i==(unsigned)num_term) break;
else strv += elem_len-i;
}
/* 08/2022 (MC): next block (if (0) {...}) is used in 4.4.1 and not the call
to __cfortran__notused_dummy
keep __cfortran__notused_dummy for easier understanding */
/*
if (0) { // to prevent not used warnings in gcc (added by ROOT)
c2fstrv(0, 0, 0, 0); f2cstrv(0, 0, 0, 0); kill_trailing(0, 0);
vkill_trailing(0, 0, 0, 0); num_elem(0, 0, 0, 0);
}
*/
if (num==0) __cfortran__notused_dummy();
return (int)num;
}
/* 08/2022 (MC): function __cfortran__notused_dummy deleted in 4.4.1
keep it for easier understanding */
static void __cfortran__notused_dummy()
{
/* to prevent not used warnings in gcc (added by ROOT) */
if (0) {
c2fstrv(0, 0, 0, 0); f2cstrv(0, 0, 0, 0); kill_trailing(0, 0);
vkill_trailing(0, 0, 0, 0); num_elem(0, 0, 0, 0);
}
}
/* #endif removed 2/10/98 (CFITSIO) */
/*-------------------------------------------------------------------------*/
/* UTILITIES FOR C TO USE STRINGS IN FORTRAN COMMON BLOCKS */
/* C string TO Fortran Common Block STRing. */
/* DIM is the number of DIMensions of the array in terms of strings, not
characters. e.g. char a[12] has DIM = 0, char a[12][4] has DIM = 1, etc. */
#define C2FCBSTR(CSTR,FSTR,DIM) \
c2fstrv((char *)CSTR, (char *)FSTR, sizeof(FSTR)/cfelementsof(FSTR,DIM)+1, \
sizeof(FSTR)+cfelementsof(FSTR,DIM))
/* Fortran Common Block string TO C STRing. */
#define FCB2CSTR(FSTR,CSTR,DIM) \
vkill_trailing(f2cstrv((char *)FSTR, (char *)CSTR, \
sizeof(FSTR)/cfelementsof(FSTR,DIM)+1, \
sizeof(FSTR)+cfelementsof(FSTR,DIM)), \
sizeof(FSTR)/cfelementsof(FSTR,DIM)+1, \
sizeof(FSTR)+cfelementsof(FSTR,DIM), ' ')
#define cfDEREFERENCE0
#define cfDEREFERENCE1 *
#define cfDEREFERENCE2 **
#define cfDEREFERENCE3 ***
#define cfDEREFERENCE4 ****
#define cfDEREFERENCE5 *****
#define cfelementsof(A,D) (sizeof(A)/sizeof( CFORTRAN_XCAT_(cfDEREFERENCE,D)(A)))
/*-------------------------------------------------------------------------*/
/* UTILITIES FOR C TO CALL FORTRAN SUBROUTINES */
/* Define lookup tables for how to handle the various types of variables. */
#define ZTRINGV_NUM(I) I
#define ZTRINGV_ARGFP(I) (*(CFORTRAN_CAT_2(A,I))) /* Undocumented. For PINT, etc. */
#define ZTRINGV_ARGF(I) CFORTRAN_CAT_2(A,I)
#ifdef CFSUBASFUN
#define ZTRINGV_ARGS(I) ZTRINGV_ARGF(I)
#else
#define ZTRINGV_ARGS(I) CFORTRAN_CAT_2(B,I)
#endif
#define PBYTE_cfVP(A,B) PINT_cfVP(A,B)
#define PDOUBLE_cfVP(A,B)
#define PFLOAT_cfVP(A,B)
#ifdef ZTRINGV_ARGS_allows_Pvariables
/* This allows Pvariables for ARGS. ARGF machinery is above ARGFP.
* B is not needed because the variable may be changed by the Fortran routine,
* but because B is the only way to access an arbitrary macro argument. */
#define PINT_cfVP(A,B) int B __CFORTRAN__PCTYPE__UNUSED__ = (int)A; /* For ZSTRINGV_ARGS */
#else
#define PINT_cfVP(A,B)
#endif
#define PLOGICAL_cfVP(A,B) int *B __CFORTRAN__PCTYPE__UNUSED__ ; /* Returning LOGICAL in FUNn and SUBn */
#define PLONG_cfVP(A,B) PINT_cfVP(A,B)
#define PSHORT_cfVP(A,B) PINT_cfVP(A,B)
#define VCF_INT_S(T,A,B) CFORTRAN_XCAT_(T,VVVVVVV_cfTYPE) B = A;
#define VCF_INT_F(T,A,B) CFORTRAN_XCAT_(T,_cfVCF)(A,B)
/* _cfVCF table is directly mapped to _cfCCC table. */
#define BYTE_cfVCF(A,B)
#define DOUBLE_cfVCF(A,B)
#define FLOAT_cfVCF(A,B)
#define INT_cfVCF(A,B)
#define LOGICAL_cfVCF(A,B)
#define LONG_cfVCF(A,B)
#define SHORT_cfVCF(A,B)
/* 980416
Cast (void (*)(CF_NULL_PROTO)) causes SunOS CC 4.2 occasionally to barf,
while the following equivalent typedef is fine.
For consistency use the typedef on all machines.
*/
typedef void (*cfCAST_FUNCTION)(CF_NULL_PROTO);
#define VCF(TN,I) _Icf4(4,V,TN, CFORTRAN_XCAT_(A,I), CFORTRAN_XCAT_(B,I),F)
#define VVCF(TN,AI,BI) _Icf4(4,V,TN,AI,BI,S)
#define INT_cfV(T,A,B,F) CFORTRAN_XCAT_(VCF_INT_,F)(T,A,B)
#define INTV_cfV(T,A,B,F)
#define INTVV_cfV(T,A,B,F)
#define INTVVV_cfV(T,A,B,F)
#define INTVVVV_cfV(T,A,B,F)
#define INTVVVVV_cfV(T,A,B,F)
#define INTVVVVVV_cfV(T,A,B,F)
#define INTVVVVVVV_cfV(T,A,B,F)
#define PINT_cfV( T,A,B,F) CFORTRAN_XCAT_(T,_cfVP)(A,B)
#define PVOID_cfV( T,A,B,F)
#if defined(hpuxFortran800) || defined(AbsoftUNIXFortran) || defined(AbsoftProFortran)
#define ROUTINE_cfV(T,A,B,F) void (*B)(CF_NULL_PROTO) = (cfCAST_FUNCTION)A;
#else
#define ROUTINE_cfV(T,A,B,F)
#endif
#define SIMPLE_cfV(T,A,B,F)
#ifdef vmsFortran
#define STRING_cfV(T,A,B,F) static struct {fstring f; unsigned clen;} B = \
{{0,DSC$K_DTYPE_T,DSC$K_CLASS_S,NULL},0};
#define PSTRING_cfV(T,A,B,F) static fstring B={0,DSC$K_DTYPE_T,DSC$K_CLASS_S,NULL};
#define STRINGV_cfV(T,A,B,F) static fstringvector B = \
{sizeof(A),DSC$K_DTYPE_T,DSC$K_CLASS_A,NULL,0,0,{0,0,1,1,1},1,0,NULL,0,{1,0}};
#define PSTRINGV_cfV(T,A,B,F) static fstringvector B = \
{0,DSC$K_DTYPE_T,DSC$K_CLASS_A,NULL,0,0,{0,0,1,1,1},1,0,NULL,0,{1,0}};
#else
#define STRING_cfV(T,A,B,F) struct {unsigned int clen, flen; char *nombre;} B;
#define STRINGV_cfV(T,A,B,F) struct {char *s, *fs; unsigned flen; char *nombre;} B;
#define PSTRING_cfV(T,A,B,F) int B;
#define PSTRINGV_cfV(T,A,B,F) struct{char *fs; unsigned int sizeofA,flen;}B;
#endif
#define ZTRINGV_cfV(T,A,B,F) STRINGV_cfV(T,A,B,F)
#define PZTRINGV_cfV(T,A,B,F) PSTRINGV_cfV(T,A,B,F)
/* Note that the actions of the A table were performed inside the AA table.
HP-UX cc, didn't evaluate arguments to functions left to
right, so we had to split the original table into the current robust two. */
#define ACF(NAME,TN,AI,I) CFORTRAN_XCAT_(TN,_cfSTR)(4,A,NAME,I,AI, CFORTRAN_XCAT_(B,I),0)
#define DEFAULT_cfA(M,I,A,B)
#define LOGICAL_cfA(M,I,A,B) B=C2FLOGICAL(B);
#define PLOGICAL_cfA(M,I,A,B) A=C2FLOGICAL(A);
#define STRING_cfA(M,I,A,B) STRING_cfC(M,I,A,B,sizeof(A))
#define PSTRING_cfA(M,I,A,B) PSTRING_cfC(M,I,A,B,sizeof(A))
#ifdef vmsFortran
#define AATRINGV_cfA( A,B, sA,filA,silA) \
initfstr(B,_cf_malloc((sA)-(filA)),(filA),(silA)-1), \
c2fstrv(A,B.dsc$a_pointer,(silA),(sA));
#define APATRINGV_cfA( A,B, sA,filA,silA) \
initfstr(B,A,(filA),(silA)-1),c2fstrv(A,A,(silA),(sA));
#else
#define AATRINGV_cfA( A,B, sA,filA,silA) \
(B.s=_cf_malloc((sA)-(filA)),B.fs=c2fstrv(A,B.s,(B.flen=(silA)-1)+1,(sA)));
#define APATRINGV_cfA( A,B, sA,filA,silA) \
B.fs=c2fstrv(A,A,(B.flen=(silA)-1)+1,B.sizeofA=(sA));
#endif
#define STRINGV_cfA(M,I,A,B) \
AATRINGV_cfA((char *)A,B,sizeof(A),firstindexlength(A),secondindexlength(A))
#define PSTRINGV_cfA(M,I,A,B) \
APATRINGV_cfA((char *)A,B,sizeof(A),firstindexlength(A),secondindexlength(A))
#define ZTRINGV_cfA(M,I,A,B) AATRINGV_cfA( (char *)A,B, \
(CFORTRAN_XCAT_3(M,_ELEMS_,I))*(( CFORTRAN_XCAT_3(M,_ELEMLEN_,I))+1), \
(CFORTRAN_XCAT_3(M,_ELEMS_,I)),(CFORTRAN_XCAT_3(M,_ELEMLEN_,I))+1)
#define PZTRINGV_cfA(M,I,A,B) APATRINGV_cfA( (char *)A,B, \
(CFORTRAN_XCAT_3(M,_ELEMS_,I))*(( CFORTRAN_XCAT_3(M,_ELEMLEN_,I))+1), \
(CFORTRAN_XCAT_3(M,_ELEMS_,I)),(CFORTRAN_XCAT_3(M,_ELEMLEN_,I))+1)
#define PBYTE_cfAAP(A,B) &A
#define PDOUBLE_cfAAP(A,B) &A
#define PFLOAT_cfAAP(A,B) FLOATVVVVVVV_cfPP &A
#define PINT_cfAAP(A,B) &A
#define PLOGICAL_cfAAP(A,B) B= &A /* B used to keep a common W table. */
#define PLONG_cfAAP(A,B) &A
#define PSHORT_cfAAP(A,B) &A
#define AACF(TN,AI,I,C) _SEP_(TN,C,cfCOMMA) _Icf(3,AA,TN,AI, CFORTRAN_XCAT_(B,I))
#define INT_cfAA(T,A,B) &B
#define INTV_cfAA(T,A,B) CFORTRAN_XCAT_(T,VVVVVV_cfPP) A
#define INTVV_cfAA(T,A,B) CFORTRAN_XCAT_(T,VVVVV_cfPP) A[0]
#define INTVVV_cfAA(T,A,B) CFORTRAN_XCAT_(T,VVVV_cfPP) A[0][0]
#define INTVVVV_cfAA(T,A,B) CFORTRAN_XCAT_(T,VVV_cfPP) A[0][0][0]
#define INTVVVVV_cfAA(T,A,B) CFORTRAN_XCAT_(T,VV_cfPP) A[0][0][0][0]
#define INTVVVVVV_cfAA(T,A,B) CFORTRAN_XCAT_(T,V_cfPP) A[0][0][0][0][0]
#define INTVVVVVVV_cfAA(T,A,B) CFORTRAN_XCAT_(T,_cfPP) A[0][0][0][0][0][0]
#define PINT_cfAA(T,A,B) CFORTRAN_XCAT_(T,_cfAAP)(A,B)
#define PVOID_cfAA(T,A,B) (void *) A
#if defined(hpuxFortran800) || defined(AbsoftUNIXFortran)
#define ROUTINE_cfAA(T,A,B) &B
#else
#define ROUTINE_cfAA(T,A,B) (cfCAST_FUNCTION)A
#endif
#define STRING_cfAA(T,A,B) STRING_cfCC(T,A,B)
#define PSTRING_cfAA(T,A,B) PSTRING_cfCC(T,A,B)
#ifdef vmsFortran
#define STRINGV_cfAA(T,A,B) &B
#else
#define STRINGV_cfAA(T,A,B) B.fs
#endif
#define PSTRINGV_cfAA(T,A,B) STRINGV_cfAA(T,A,B)
#define ZTRINGV_cfAA(T,A,B) STRINGV_cfAA(T,A,B)
#define PZTRINGV_cfAA(T,A,B) STRINGV_cfAA(T,A,B)
#if defined(vmsFortran) || defined(CRAYFortran)
#define JCF(TN,I)
#define KCF(TN,I)
#else
#define JCF(TN,I) CFORTRAN_XCAT_(TN,_cfSTR)(1,J, CFORTRAN_XCAT_(B,I), 0,0,0,0)
#if defined(AbsoftUNIXFortran)
#define DEFAULT_cfJ(B) ,0
#else
#define DEFAULT_cfJ(B)
#endif
#define LOGICAL_cfJ(B) DEFAULT_cfJ(B)
#define PLOGICAL_cfJ(B) DEFAULT_cfJ(B)
#define STRING_cfJ(B) ,B.flen
#define PSTRING_cfJ(B) ,B
#define STRINGV_cfJ(B) STRING_cfJ(B)
#define PSTRINGV_cfJ(B) STRING_cfJ(B)
#define ZTRINGV_cfJ(B) STRING_cfJ(B)
#define PZTRINGV_cfJ(B) STRING_cfJ(B)
/* KCF is identical to DCF, except that KCF ZTRING is not empty. */
#define KCF(TN,I) CFORTRAN_XCAT_(TN,_cfSTR)(1,KK, CFORTRAN_XCAT_(B,I), 0,0,0,0)
#if defined(AbsoftUNIXFortran)
#define DEFAULT_cfKK(B) , unsigned B
#else
#define DEFAULT_cfKK(B)
#endif
#define LOGICAL_cfKK(B) DEFAULT_cfKK(B)
#define PLOGICAL_cfKK(B) DEFAULT_cfKK(B)
#define STRING_cfKK(B) , unsigned B
#define PSTRING_cfKK(B) STRING_cfKK(B)
#define STRINGV_cfKK(B) STRING_cfKK(B)
#define PSTRINGV_cfKK(B) STRING_cfKK(B)
#define ZTRINGV_cfKK(B) STRING_cfKK(B)
#define PZTRINGV_cfKK(B) STRING_cfKK(B)
#endif
#define WCF(TN,AN,I) CFORTRAN_XCAT_(TN,_cfSTR)(2,W,AN, CFORTRAN_XCAT_(B,I), 0,0,0)
#define DEFAULT_cfW(A,B)
#define LOGICAL_cfW(A,B)
#define PLOGICAL_cfW(A,B) *B=F2CLOGICAL(*B);
#define STRING_cfW(A,B) (B.nombre=A,B.nombre[B.clen]!='\0'?B.nombre[B.clen]='\0':0); /* A?="constnt"*/
#define PSTRING_cfW(A,B) kill_trailing(A,' ');
#ifdef vmsFortran
#define STRINGV_cfW(A,B) _cf_free(B.dsc$a_pointer);
#define PSTRINGV_cfW(A,B) \
vkill_trailing(f2cstrv((char*)A, (char*)A, \
B.dsc$w_length+1, B.dsc$l_arsize+B.dsc$l_m[0]), \
B.dsc$w_length+1, B.dsc$l_arsize+B.dsc$l_m[0], ' ');
#else
#define STRINGV_cfW(A,B) _cf_free(B.s);
#define PSTRINGV_cfW(A,B) vkill_trailing( \
f2cstrv((char*)A,(char*)A,B.flen+1,B.sizeofA), B.flen+1,B.sizeofA,' ');
#endif
#define ZTRINGV_cfW(A,B) STRINGV_cfW(A,B)
#define PZTRINGV_cfW(A,B) PSTRINGV_cfW(A,B)
#define NCF(TN,I,C) _SEP_(TN,C,cfCOMMA) _Icf(2,N,TN, CFORTRAN_XCAT_(A,I),0)
#define NNCF(TN,I,C) UUCF(TN,I,C)
#define NNNCF(TN,I,C) _SEP_(TN,C,cfCOLON) _Icf(2,N,TN, CFORTRAN_XCAT_(A,I),0)
#define INT_cfN(T,A) CFORTRAN_XCAT_(T,VVVVVVV_cfTYPE) * A
#define INTV_cfN(T,A) CFORTRAN_XCAT_(T,VVVVVV_cfTYPE) * A
#define INTVV_cfN(T,A) CFORTRAN_XCAT_(T,VVVVV_cfTYPE) * A
#define INTVVV_cfN(T,A) CFORTRAN_XCAT_(T,VVVV_cfTYPE) * A
#define INTVVVV_cfN(T,A) CFORTRAN_XCAT_(T,VVV_cfTYPE) * A
#define INTVVVVV_cfN(T,A) CFORTRAN_XCAT_(T,VV_cfTYPE) * A
#define INTVVVVVV_cfN(T,A) CFORTRAN_XCAT_(T,V_cfTYPE) * A
#define INTVVVVVVV_cfN(T,A) CFORTRAN_XCAT_(T,_cfTYPE) * A
#define PINT_cfN(T,A) CFORTRAN_XCAT_(T,_cfTYPE) * A
#define PVOID_cfN(T,A) void * A
#if defined(hpuxFortran800) || defined(AbsoftUNIXFortran)
#define ROUTINE_cfN(T,A) void (**A)(CF_NULL_PROTO)
#else
#define ROUTINE_cfN(T,A) void ( *A)(CF_NULL_PROTO)
#endif
#ifdef vmsFortran
#define STRING_cfN(T,A) fstring * A
#define STRINGV_cfN(T,A) fstringvector * A
#else
#define STRING_cfN(T,A) char * A
#define STRINGV_cfN(T,A) char * A
#endif
#define PSTRING_cfN(T,A) STRING_cfN(T,A) /* CRAY insists on arg.'s here. */
#define PNSTRING_cfN(T,A) STRING_cfN(T,A) /* CRAY insists on arg.'s here. */
#define PPSTRING_cfN(T,A) STRING_cfN(T,A) /* CRAY insists on arg.'s here. */
#define PSTRINGV_cfN(T,A) STRINGV_cfN(T,A)
#define ZTRINGV_cfN(T,A) STRINGV_cfN(T,A)
#define PZTRINGV_cfN(T,A) PSTRINGV_cfN(T,A)
/* CRAY, old Sun
can't hack more than 31 arg's.
e.g. ultrix >= 4.3 gives message:
zow35> cc -c -DDECFortran cfortest.c
cfe: Fatal: Out of memory: cfortest.c
zow35>
Old __hpux had the problem, but new 'HP-UX A.09.03 A 9000/735' is fine
if using -Aa, otherwise we have a problem.
*/
#ifndef MAX_PREPRO_ARGS
#if !defined(__GNUC__) && ((defined(sun)&&!defined(__sun)) || defined(_CRAY))
#define MAX_PREPRO_ARGS 31
#else
#define MAX_PREPRO_ARGS 99
#endif
#endif
#if defined(AbsoftUNIXFortran) || defined(AbsoftProFortran)
/* In addition to explicit Absoft stuff, only Absoft requires:
- DEFAULT coming from _cfSTR.
DEFAULT could have been called e.g. INT, but keep it for clarity.
- M term in CFARGT14 and CFARGT14FS.
*/
#define ABSOFT_cf1(T0) CFORTRAN_XCAT_(T0,_cfSTR)(0,ABSOFT1,0,0,0,0,0)
#define ABSOFT_cf2(T0) CFORTRAN_XCAT_(T0,_cfSTR)(0,ABSOFT2,0,0,0,0,0)
#define ABSOFT_cf3(T0) CFORTRAN_XCAT_(T0,_cfSTR)(0,ABSOFT3,0,0,0,0,0)
#define DEFAULT_cfABSOFT1
#define LOGICAL_cfABSOFT1
#define STRING_cfABSOFT1 ,MAX_LEN_FORTRAN_FUNCTION_STRING
#define DEFAULT_cfABSOFT2
#define LOGICAL_cfABSOFT2
#define STRING_cfABSOFT2 ,unsigned D0
#define DEFAULT_cfABSOFT3
#define LOGICAL_cfABSOFT3
#define STRING_cfABSOFT3 ,D0
#else
#define ABSOFT_cf1(T0)
#define ABSOFT_cf2(T0)
#define ABSOFT_cf3(T0)
#endif
/* _Z introduced to cicumvent IBM and HP silly preprocessor warning.
e.g. "Macro CFARGT14 invoked with a null argument."
*/
#define _Z
#define CFARGT14S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
S(T1,1) S(T2,2) S(T3,3) S(T4,4) S(T5,5) S(T6,6) S(T7,7) \
S(T8,8) S(T9,9) S(TA,10) S(TB,11) S(TC,12) S(TD,13) S(TE,14)
#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) \
S(T1,1) S(T2,2) S(T3,3) S(T4,4) S(T5,5) S(T6,6) S(T7,7) \
S(T8,8) S(T9,9) S(TA,10) S(TB,11) S(TC,12) S(TD,13) S(TE,14) \
S(TF,15) S(TG,16) S(TH,17) S(TI,18) S(TJ,19) S(TK,20) S(TL,21) \