cfortran.h 124 KB
Newer Older
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  4.3 */
/* http://www-zeus.desy.de/~burow/cfortran/                   */
/* Burkhard Burow  burow@desy.de                 1990 - 2001. */

#ifndef __CFORTRAN_LOADED
#define __CFORTRAN_LOADED

/* 
   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.
*/

/* 
  Avoid symbols already used by compilers and system *.h:
  __ - OSF1 zukal06 V3.0 347 alpha, cc -c -std1 cfortest.c

 */


/* First prepare for the C compiler. */

#ifndef ANSI_C_preprocessor /* i.e. user can override. */
#ifdef __CF__KnR
#define ANSI_C_preprocessor 0
#else
#ifdef __STDC__
#define ANSI_C_preprocessor 1
#else
#define _cfleft             1
#define _cfright 
#define _cfleft_cfright     0
#define ANSI_C_preprocessor _cfleft/**/_cfright
#endif
#endif
#endif

#if ANSI_C_preprocessor
#define _0(A,B)   A##B
#define  _(A,B)   _0(A,B)  /* see cat,xcat of K&R ANSI C p. 231 */
#define _2(A,B)   A##B     /* K&R ANSI C p.230: .. identifier is not replaced */
#define _3(A,B,C) _(A,_(B,C))
#else                      /* if it turns up again during rescanning.         */
#define  _(A,B)   A/**/B
#define _2(A,B)   A/**/B
#define _3(A,B,C) A/**/B/**/C
#endif

#if (defined(vax)&&defined(unix)) || (defined(__vax__)&&defined(__unix__))
#define VAXUltrix
#endif

#include <stdio.h>     /* NULL [in all machines stdio.h]                      */
#include <string.h>    /* strlen, memset, memcpy, memchr.                     */
#if !( defined(VAXUltrix) || defined(sun) || (defined(apollo)&&!defined(__STDCPP__)) )
#include <stdlib.h>    /* malloc,free                                         */
#else
#include <malloc.h>    /* Had to be removed for DomainOS h105 10.4 sys5.3 425t*/
#ifdef apollo
#define __CF__APOLLO67 /* __STDCPP__ is in Apollo 6.8 (i.e. ANSI) and onwards */
#endif
#endif

#if !defined(__GNUC__) && !defined(__sun) && (defined(sun)||defined(VAXUltrix)||defined(lynx))
#define __CF__KnR     /* Sun, LynxOS and VAX Ultrix cc only supports K&R.     */
                      /* Manually define __CF__KnR for HP if desired/required.*/
#endif                /*       i.e. We will generate Kernighan and Ritchie C. */
/* Note that you may define __CF__KnR before #include cfortran.h, in order to
generate K&R C instead of the default ANSI C. The differences are mainly in the
function prototypes and declarations. All machines, except the Apollo, work
with either style. The Apollo's argument promotion rules require ANSI or use of
the obsolete std_$call which we have not implemented here. Hence on the Apollo,
only C calling FORTRAN subroutines will work using K&R style.*/


/* Remainder of cfortran.h depends on the Fortran compiler. */

#if defined(CLIPPERFortran) || defined(pgiFortran)
#define f2cFortran
#endif

/* VAX/VMS does not let us \-split long #if lines. */ 
/* Split #if into 2 because some HP-UX can't handle long #if */
#if !(defined(NAGf90Fortran)||defined(f2cFortran)||defined(hpuxFortran)||defined(apolloFortran)||defined(sunFortran)||defined(IBMR2Fortran)||defined(CRAYFortran))
#if !(defined(mipsFortran)||defined(DECFortran)||defined(vmsFortran)||defined(CONVEXFortran)||defined(PowerStationFortran)||defined(AbsoftUNIXFortran)||defined(AbsoftProFortran)||defined(SXFortran))
/* If no Fortran compiler is given, we choose one for the machines we know.   */
#if defined(lynx) || defined(VAXUltrix)
#define f2cFortran    /* Lynx:      Only support f2c at the moment.
                         VAXUltrix: f77 behaves like f2c.
                           Support f2c or f77 with gcc, vcc with f2c. 
                           f77 with vcc works, missing link magic for f77 I/O.*/
#endif
#if defined(__hpux)             /* 921107: Use __hpux instead of __hp9000s300 */
#define       hpuxFortran       /*         Should also allow hp9000s7/800 use.*/
#endif
#if       defined(apollo)
#define           apolloFortran /* __CF__APOLLO67 also defines some behavior. */
#endif
#if          defined(sun) || defined(__sun) 
#define              sunFortran
#endif
#if       defined(_IBMR2)
#define            IBMR2Fortran
#endif
#if        defined(_CRAY)
#define             CRAYFortran /*       _CRAYT3E also defines some behavior. */
#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 /* ...Fortran */
#endif /* ...Fortran */

/* Split #if into 2 because some HP-UX can't handle long #if */
#if !(defined(NAGf90Fortran)||defined(f2cFortran)||defined(hpuxFortran)||defined(apolloFortran)||defined(sunFortran)||defined(IBMR2Fortran)||defined(CRAYFortran))
#if !(defined(mipsFortran)||defined(DECFortran)||defined(vmsFortran)||defined(CONVEXFortran)||defined(PowerStationFortran)||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:\
    - MIPS cc and f77 2.0. (e.g. Silicon Graphics, DECstations, ...)     \
    - IBM AIX XL C and FORTRAN Compiler/6000 Version 01.01.0000.0000     \
    - VAX   VMS CC 3.1 and FORTRAN 5.4.                                  \
    - 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          \
    - Apollo DomainOS 10.2 (sys5.3) with f77 10.7 and cc 6.7.            \
    - 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.                                        \
    - VAXUltrix: vcc,cc or gcc with f2c. gcc or cc with f77.             \
    -            f77 with vcc works; but missing link magic for f77 I/O. \
    -            NO fort. None of gcc, cc or vcc generate required names.\
    - f2c    : Use #define    f2cFortran, or cc -Df2cFortran             \
    - NAG f90: Use #define NAGf90Fortran, or cc -DNAGf90Fortran          \
    - Absoft UNIX F77: Use #define AbsoftUNIXFortran or cc -DAbsoftUNIXFortran \
    - Absoft Pro Fortran: Use #define AbsoftProFortran \
    - Portland Group Fortran: Use #define pgiFortran"
/* Compiler must throw us out at this point! */
#endif
#endif


#if defined(VAXC) && !defined(__VAXC)
#define OLD_VAXC
#pragma nostandard                       /* Prevent %CC-I-PARAMNOTUSED.       */
#endif

/* Throughout cfortran.h we use: UN = Uppercase Name.  LN = Lowercase Name.   */

#if defined(f2cFortran) || defined(NAGf90Fortran) || defined(DECFortran) || defined(mipsFortran) || defined(apolloFortran) || defined(sunFortran) || defined(CONVEXFortran) || defined(SXFortran) || defined(extname)
#define CFC_(UN,LN)            _(LN,_)      /* Lowercase FORTRAN symbols.     */
#define orig_fcallsc(UN,LN)    CFC_(UN,LN)
#else 
#if defined(CRAYFortran) || defined(PowerStationFortran) || defined(AbsoftProFortran)
#ifdef _CRAY          /* (UN), not UN, circumvents CRAY preprocessor bug.     */
#define CFC_(UN,LN)            (UN)         /* Uppercase FORTRAN symbols.     */
#else                 /* At least VISUAL_CPLUSPLUS barfs on (UN), so need UN. */
#define CFC_(UN,LN)            UN           /* Uppercase FORTRAN symbols.     */
#endif
#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 VAX/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_(_(P,UN),_(p,LN))
#define  append_fcallsc(P,p,UN,LN)   CFC_(_(UN,P),_(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)          _(_C,LN)
#endif  /* AbsoftUNIXFortran or AbsoftProFortran */
#else
#define COMMON_BLOCK(UN,LN)          _(LN,__)
#endif  /* CLIPPERFortran */
#else
#define COMMON_BLOCK(UN,LN)          _3(_,LN,_)
#endif  /* CONVEXFortran */
#endif  /* COMMON_BLOCK */

#ifndef DOUBLE_PRECISION
#if defined(CRAYFortran) && !defined(_CRAYT3E)
#define DOUBLE_PRECISION long double
#else
#define DOUBLE_PRECISION double
#endif
#endif

#ifndef FORTRAN_REAL
#if defined(CRAYFortran) &&  defined(_CRAYT3E)
#define FORTRAN_REAL double
#else
#define FORTRAN_REAL float
#endif
#endif

#ifdef CRAYFortran
#ifdef _CRAY
#include <fortran.h>
#else
#include "fortran.h"  /* i.e. if crosscompiling assume user has file. */
#endif
#define FLOATVVVVVVV_cfPP (FORTRAN_REAL *)   /* Used for C calls FORTRAN.     */
/* CRAY's double==float but CRAY says pointers to doubles and floats are diff.*/
#define VOIDP  (void *)  /* When FORTRAN calls C, we don't know if C routine 
                            arg.'s have been declared float *, or double *.   */
#else
#define FLOATVVVVVVV_cfPP
#define VOIDP
#endif

#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

#ifndef apolloFortran
#define COMMON_BLOCK_DEF(DEFINITION, NAME) extern DEFINITION NAME
#define CF_NULL_PROTO
#else                                         /* HP doesn't understand #elif. */
/* Without ANSI prototyping, Apollo promotes float functions to double.    */
/* Note that VAX/VMS, IBM, Mips choke on 'type function(...);' prototypes. */
#define CF_NULL_PROTO ...
#ifndef __CF__APOLLO67
#define COMMON_BLOCK_DEF(DEFINITION, NAME) \
 DEFINITION NAME __attribute((__section(NAME)))
#else
#define COMMON_BLOCK_DEF(DEFINITION, NAME) \
 DEFINITION NAME #attribute[section(NAME)]
#endif
#endif

#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

#ifdef OLD_VAXC                          /* Allow %CC-I-PARAMNOTUSED.         */
#pragma standard                         
#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], VAX Ultrix f77,
HP-UX f77                                        : as in C.
VAX/VMS FORTRAN, VAX Ultrix fort,
Absoft Unix Fortran, IBM RS/6000 xlf             : LS Bit = 0/1 = TRUE/FALSE.
Apollo                                           : neg.   = TRUE, else FALSE. 
[Apollo accepts -1 as TRUE for function values, but NOT all other neg. values.]
[DECFortran for Ultrix RISC is also called f77 but is the same as VAX/VMS.]   
[MIPS f77 treats .eqv./.neqv. as .eq./.ne. and hence requires LOGICAL_STRICT.]*/

#if 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(apolloFortran)
#define C2FLOGICAL(L) ((L)?-1:(L)&~((unsigned)1<<sizeof(int)*8-1))
#define F2CLOGICAL(L) ((L)<0?(L):0) 
#else
#if defined(CRAYFortran)
#define C2FLOGICAL(L) _btol(L)
#define F2CLOGICAL(L) _ltob(&(L))     /* Strangely _ltob() expects a pointer. */
#else
#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 */
#endif  /* CRAYFortran                        */
#endif  /* apolloFortran                      */

/* 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)
   - (1) may not even be FORTRAN/77 and that Apollo's f77 and IBM's xlf
     refuse to compile (1), so you are probably well advised to stay away from 
     (1) and from LOGICAL_STRICT.
   - You pay a (slight) performance penalty for using LOGICAL_STRICT. */
#undef  C2FLOGICAL
#ifdef hpuxFortran800
#define C2FLOGICAL(L) ((L)?0x01000000:0)
#else
#if defined(apolloFortran) || 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. */
#ifndef __CF__KnR
static char *c2fstrv(char* cstr, char *fstr, int elem_len, int sizeofcstr)
#else
static char *c2fstrv(      cstr,       fstr,     elem_len,     sizeofcstr)
                     char* cstr; char *fstr; int elem_len; int sizeofcstr;
#endif
{ 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. */
#ifndef __CF__KnR
static char *f2cstrv(char *fstr, char* cstr, int elem_len, int sizeofcstr)
#else
static char *f2cstrv(      fstr,       cstr,     elem_len,     sizeofcstr)
                     char *fstr; char* cstr; int elem_len; int sizeofcstr; 
#endif
{ 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. */
#ifndef __CF__KnR
static char *kill_trailing(char *s, char t)
#else
static char *kill_trailing(      s,      t) char *s; char t;
#endif
{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. */ 
#ifndef __CF__KnR
static char *kill_trailingn(char *s, char t, char *e)
#else
static char *kill_trailingn(      s,      t,       e) char *s; char t; char *e;
#endif
{ 
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. */
#ifndef __CF__KnR
static char *vkill_trailing(char* cstr, int elem_len, int sizeofcstr, char t)
#else
static char *vkill_trailing(      cstr,     elem_len,     sizeofcstr,      t)
                            char* cstr; int elem_len; int sizeofcstr; char t;
#endif
{ 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))

#else
#define _NUM_ELEMS      -1
#define _NUM_ELEM_ARG   -2
#define NUM_ELEMS(A)    A,_NUM_ELEMS
#define NUM_ELEM_ARG(B) *_2(A,B),_NUM_ELEM_ARG
#define TERM_CHARS(A,B) A,B
#ifndef __CF__KnR
static int num_elem(char *strv, unsigned elem_len, int term_char, int num_term)
#else
static int num_elem(      strv,          elem_len,     term_char,     num_term)
                    char *strv; unsigned elem_len; int term_char; int num_term;
#endif
/* 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;
}
return (int)num;
}
#endif
/*-------------------------------------------------------------------------*/

/*           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(_(cfDEREFERENCE,D)(A)))

/*-------------------------------------------------------------------------*/

/*               UTILITIES FOR C TO CALL FORTRAN SUBROUTINES               */

/* Define lookup tables for how to handle the various types of variables.  */

#ifdef OLD_VAXC                                /* Prevent %CC-I-PARAMNOTUSED. */
#pragma nostandard
#endif

#define ZTRINGV_NUM(I)       I
#define ZTRINGV_ARGFP(I) (*(_2(A,I))) /* Undocumented. For PINT, etc. */
#define ZTRINGV_ARGF(I) _2(A,I)
#ifdef CFSUBASFUN
#define ZTRINGV_ARGS(I) ZTRINGV_ARGF(I)
#else
#define ZTRINGV_ARGS(I) _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 = (int)A;              /* For ZSTRINGV_ARGS */
#else
#define     PINT_cfVP(A,B)
#endif
#define PLOGICAL_cfVP(A,B) int *B;      /* 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) _(T,VVVVVVV_cfTYPE) B = A;
#define        VCF_INT_F(T,A,B) _(T,_cfVCF)(A,B)
/* _cfVCF table is directly mapped to _cfCCC table. */
#define     BYTE_cfVCF(A,B)
#define   DOUBLE_cfVCF(A,B)
#if !defined(__CF__KnR)
#define    FLOAT_cfVCF(A,B)
#else
#define    FLOAT_cfVCF(A,B) FORTRAN_REAL B = A;
#endif
#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,_(A,I),_(B,I),F)
#define VVCF(TN,AI,BI)  _Icf4(4,V,TN,AI,BI,S)
#define        INT_cfV(T,A,B,F) _(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) _(T,_cfVP)(A,B)
#define PVOID_cfV(     T,A,B,F)
#if defined(apolloFortran) || 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;} B;
#define    STRINGV_cfV(T,A,B,F) struct {char *s, *fs; unsigned flen;} 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.
   VAX Ultrix vcc, and 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)      _(TN,_cfSTR)(4,A,NAME,I,AI,_(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,                     \
                    (_3(M,_ELEMS_,I))*(( _3(M,_ELEMLEN_,I))+1),                \
                              (_3(M,_ELEMS_,I)),(_3(M,_ELEMLEN_,I))+1)
#define  PZTRINGV_cfA(M,I,A,B) APATRINGV_cfA( (char *)A,B,                     \
                    (_3(M,_ELEMS_,I))*(( _3(M,_ELEMLEN_,I))+1),                \
                              (_3(M,_ELEMS_,I)),(_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,_(B,I))
#define        INT_cfAA(T,A,B) &B
#define       INTV_cfAA(T,A,B) _(T,VVVVVV_cfPP) A
#define      INTVV_cfAA(T,A,B) _(T,VVVVV_cfPP)  A[0]
#define     INTVVV_cfAA(T,A,B) _(T,VVVV_cfPP)   A[0][0]
#define    INTVVVV_cfAA(T,A,B) _(T,VVV_cfPP)    A[0][0][0]
#define   INTVVVVV_cfAA(T,A,B) _(T,VV_cfPP)     A[0][0][0][0]
#define  INTVVVVVV_cfAA(T,A,B) _(T,V_cfPP)      A[0][0][0][0][0]
#define INTVVVVVVV_cfAA(T,A,B) _(T,_cfPP)       A[0][0][0][0][0][0]
#define       PINT_cfAA(T,A,B) _(T,_cfAAP)(A,B)
#define      PVOID_cfAA(T,A,B) (void *) A
#if defined(apolloFortran) || 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
#ifdef CRAYFortran
#define    STRINGV_cfAA(T,A,B) _cptofcd(B.fs,B.flen)
#else
#define    STRINGV_cfAA(T,A,B) B.fs
#endif
#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)    _(TN,_cfSTR)(1,J,_(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)    _(TN,_cfSTR)(1,KK,_(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)      _(TN,_cfSTR)(2,W,AN,_(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) (A[B.clen]!='\0'?A[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,_(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,_(A,I),0) 
#define        INT_cfN(T,A) _(T,VVVVVVV_cfTYPE) * A
#define       INTV_cfN(T,A) _(T,VVVVVV_cfTYPE)  * A
#define      INTVV_cfN(T,A) _(T,VVVVV_cfTYPE)   * A
#define     INTVVV_cfN(T,A) _(T,VVVV_cfTYPE)    * A
#define    INTVVVV_cfN(T,A) _(T,VVV_cfTYPE)     * A
#define   INTVVVVV_cfN(T,A) _(T,VV_cfTYPE)      * A
#define  INTVVVVVV_cfN(T,A) _(T,V_cfTYPE)       * A
#define INTVVVVVVV_cfN(T,A) _(T,_cfTYPE)        * A
#define       PINT_cfN(T,A) _(T,_cfTYPE)        * A
#define      PVOID_cfN(T,A) void *                A
#if defined(apolloFortran) || 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
#ifdef CRAYFortran
#define     STRING_cfN(T,A) _fcd                  A
#define    STRINGV_cfN(T,A) _fcd                  A
#else
#define     STRING_cfN(T,A) char *                A
#define    STRINGV_cfN(T,A) char *                A
#endif
#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)


/* Apollo 6.7, CRAY, old Sun, VAX/Ultrix vcc/cc and new ultrix
   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(VAXUltrix) || defined(__CF__APOLLO67) || (defined(sun)&&!defined(__sun)) || defined(_CRAY) || defined(__ultrix__) || (defined(__hpux)&&defined(__CF__KnR)))
#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) _(T0,_cfSTR)(0,ABSOFT1,0,0,0,0,0)
#define ABSOFT_cf2(T0) _(T0,_cfSTR)(0,ABSOFT2,0,0,0,0,0)
#define ABSOFT_cf3(T0) _(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)      \
 S(TM,22)  S(TN,23)  S(TO,24)   S(TP,25)   S(TQ,26)   S(TR,27)

#define  CFARGT14FS(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)           \
 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)     \
 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)    \
 M       CFARGT14S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
#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) \
 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)   \
 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)  \
 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)  \
 F(TM,22,1) F(TN,23,1) F(TO,24,1) F(TP,25,1) F(TQ,26,1) F(TR,27,1)             \
 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)

#if !(defined(PowerStationFortran)||defined(hpuxFortran800))
/*  Old CFARGT14 -> CFARGT14FS as seen below, for Absoft cross-compile yields:
      SunOS> cc -c -Xa -DAbsoftUNIXFortran c.c
      "c.c", line 406: warning: argument mismatch
    Haven't checked if this is ANSI C or a SunOS bug. SunOS -Xs works ok.
    Behavior is most clearly seen in example:
      #define A 1 , 2
      #define  C(X,Y,Z) x=X. y=Y. z=Z.
      #define  D(X,Y,Z) C(X,Y,Z)
      D(x,A,z)
    Output from preprocessor is: x = x . y = 1 . z = 2 .
 #define CFARGT14(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
       CFARGT14FS(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
*/
#define  CFARGT14(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)             \
 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)     \
 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)    \
 M       CFARGT14S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
#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) \
 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)   \
 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)  \
 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)  \
 F(TM,22,1) F(TN,23,1) F(TO,24,1) F(TP,25,1) F(TQ,26,1) F(TR,27,1)             \
 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)

#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) \
 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)   \
 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)  \
 F(TF,15,1) F(TG,16,1) F(TH,17,1) F(TI,18,1) F(TJ,19,1) F(TK,20,1)             \
 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)
#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) \
 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)  \
 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) \
 F(TD,AD,13,1) F(TE,AE,14,1) 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)
#if MAX_PREPRO_ARGS>31
#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) \
 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)  \
 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) \
 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) \
 F(TJ,AJ,19,1) F(TK,AK,20,1) 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)
#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) \
 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)  \
 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) \
 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) \
 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) \
 F(TP,AP,25,1) F(TQ,AQ,26,1) F(TR,AR,27,1) 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)      \
 S(TM,22)      S(TN,23)      S(TO,24)      S(TP,25)      S(TQ,26)      S(TR,27)
#endif
#else
#define  CFARGT14(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)             \
 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)  \
 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)  \
 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) \
 F(TD,13,1) S(TD,13) F(TE,14,1) S(TE,14)
#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) \
 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)  \
 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)  \
 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) \
 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) \
 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) \
 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) \
 F(TP,25,1) S(TP,25) F(TQ,26,1) S(TQ,26) F(TR,27,1) S(TR,27)

#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) \
 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)  \
 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)  \
 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) \
 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) \
 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)
#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) \
 F(T1,A1,1,0)  S(T1,1)  F(T2,A2,2,1)  S(T2,2)  F(T3,A3,3,1)  S(T3,3)           \
 F(T4,A4,4,1)  S(T4,4)  F(T5,A5,5,1)  S(T5,5)  F(T6,A6,6,1)  S(T6,6)           \
 F(T7,A7,7,1)  S(T7,7)  F(T8,A8,8,1)  S(T8,8)  F(T9,A9,9,1)  S(T9,9)           \
 F(TA,AA,10,1) S(TA,10) F(TB,AB,11,1) S(TB,11) F(TC,AC,12,1) S(TC,12)          \
 F(TD,AD,13,1) S(TD,13) F(TE,AE,14,1) S(TE,14)
#if MAX_PREPRO_ARGS>31
#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) \
 F(T1,A1,1,0)  S(T1,1)  F(T2,A2,2,1)  S(T2,2)  F(T3,A3,3,1)  S(T3,3)           \
 F(T4,A4,4,1)  S(T4,4)  F(T5,A5,5,1)  S(T5,5)  F(T6,A6,6,1)  S(T6,6)           \
 F(T7,A7,7,1)  S(T7,7)  F(T8,A8,8,1)  S(T8,8)  F(T9,A9,9,1)  S(T9,9)           \
 F(TA,AA,10,1) S(TA,10) F(TB,AB,11,1) S(TB,11) F(TC,AC,12,1) S(TC,12)          \
 F(TD,AD,13,1) S(TD,13) F(TE,AE,14,1) S(TE,14) F(TF,AF,15,1) S(TF,15)          \
 F(TG,AG,16,1) S(TG,16) F(TH,AH,17,1) S(TH,17) F(TI,AI,18,1) S(TI,18)          \
 F(TJ,AJ,19,1) S(TJ,19) F(TK,AK,20,1) S(TK,20)                
#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) \
 F(T1,A1,1,0)  S(T1,1)  F(T2,A2,2,1)  S(T2,2)  F(T3,A3,3,1)  S(T3,3)           \
 F(T4,A4,4,1)  S(T4,4)  F(T5,A5,5,1)  S(T5,5)  F(T6,A6,6,1)  S(T6,6)           \
 F(T7,A7,7,1)  S(T7,7)  F(T8,A8,8,1)  S(T8,8)  F(T9,A9,9,1)  S(T9,9)           \
 F(TA,AA,10,1) S(TA,10) F(TB,AB,11,1) S(TB,11) F(TC,AC,12,1) S(TC,12)          \
 F(TD,AD,13,1) S(TD,13) F(TE,AE,14,1) S(TE,14) F(TF,AF,15,1) S(TF,15)          \
 F(TG,AG,16,1) S(TG,16) F(TH,AH,17,1) S(TH,17) F(TI,AI,18,1) S(TI,18)          \
 F(TJ,AJ,19,1) S(TJ,19) F(TK,AK,20,1) S(TK,20) F(TL,AL,21,1) S(TL,21)          \
 F(TM,AM,22,1) S(TM,22) F(TN,AN,23,1) S(TN,23) F(TO,AO,24,1) S(TO,24)          \
 F(TP,AP,25,1) S(TP,25) F(TQ,AQ,26,1) S(TQ,26) F(TR,AR,27,1) S(TR,27)
#endif
#endif


For faster browsing, not all history is shown. View entire blame