/usr/include/hdf-eos5/cfortHdf.h is in libhe5-hdfeos-dev 5.1.16.dfsg.1-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 | /*
Copyright (C) 1996 Hughes and Applied Research Corporation
Permission to use, modify, and distribute this software and its documentation
for any purpose without fee is hereby granted, provided that the above
copyright notice appear in all copies and that both that copyright notice and
this permission notice appear in supporting documentation.
*/
/* cfortran.h */ /* 2.8 */ /* anonymous ftp: zebra.desy.de */
/* Burkhard Burow, burow@vxdesy.cern.ch, University of Toronto, 1993. */
/* Feb 2008 Abe Taaheri extensed "fortran to C calls" to 15 argument funcs */
#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.
*/
/* Before using cfortran.h on CRAY, RS/6000, Apollo >=6.8, gcc -ansi,
or any other ANSI C compiler, you must once do:
prompt> mv cfortran.h cf_temp.h && sed 's/\/\*\*\//\#\#/g' cf_temp.h >cfortran.h
i.e. we change the ' / * * / ' kludge to # #. */
/* First prepare for the C compiler. */
#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>
#ifdef apollo
#define __CF__APOLLO67 /* __STDCPP__ is in Apollo 6.8 (i.e. ANSI) and onwards */
#endif
#endif
#if (!defined(__GNUC__) && (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. */
/* VAX/VMS does not let us \-split these long lines. */
#if !(defined(NAGf90Fortran)||defined(f2cFortran)||defined(hpuxFortran)||defined(apolloFortran)||defined(sunFortran)||defined(IBMR2Fortran)||defined(CRAYFortran)||defined(mipsFortran)||defined(DECFortran)||defined(vmsFortran))
/* 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 defines some behavior. */
#endif
#if defined(sun)
#define sunFortran
#endif
#if defined(_IBMR2)
#define IBMR2Fortran
#endif
#if defined(_CRAY)
#define CRAYFortran /* _CRAY2 defines some behavior. */
#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
#endif /* ...Fortran */
#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(extname)
#if defined(f2cFortran)
#define CFC_(UN,LN) LN##_ /* Lowercase FORTRAN symbols. */
#else
#define CFC_(UN,LN) LN##_ /* Lowercase FORTRAN symbols. */
#endif /* f2cFortran */
#define orig_fcallsc CFC_
#else
#ifdef CRAYFortran
#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 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 CFC_
#endif /* vmsFortran */
#endif /* CRAYFortran */
#endif /* ....Fortran */
#define fcallsc orig_fcallsc
#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 fcallsc
#define FORTRAN_FUNCTION CFC_
#define COMMON_BLOCK CFC_
#if defined(NAGf90Fortran) || defined(f2cFortran) || defined(mipsFortran)
#define LOGICAL_STRICT /* These have .eqv./.neqv. == .eq./.ne. */
#endif
#ifdef CRAYFortran
#if _CRAY
#include <fortran.h>
#else
#include "fortran.h" /* i.e. if crosscompiling assume user has file. */
#endif
#define DOUBLE_PRECISION long double
#define PPFLOATVVVVVVV (float *) /* Used for C calls FORTRAN. */
/* CRAY's double==float but CRAY says pointers to doubles and floats are diff.*/
#define VOIDP0 (void *) /* When FORTRAN calls C, we don't know if C routine
arg.'s have been declared float *, or double *. */
#else
#define DOUBLE_PRECISION double
#define PPFLOATVVVVVVV
#define VOIDP0
#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 sun
#include <math.h> /* Sun's FLOATFUNCTIONTYPE, ASSIGNFLOAT, RETURNFLOAT. */
#else
#include "math.h" /* i.e. if crosscompiling assume user has file. */
#endif
#endif
#ifdef __cplusplus
extern "C" {
#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 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 ACOMMA ,
#define ACOLON ;
/*-------------------------------------------------------------------------*/
/* UTILITIES USED WITHIN CFORTRAN.H */
#define PGSMIN(A,B) (A<B?A:B)
#define firstindexlength( A) (sizeof(A) /sizeof(A[0]))
#define secondindexlength(A) (sizeof((A)[0])/sizeof((A)[0][0]))
#ifndef FALSE
#define FALSE (1==0)
#endif
/* 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, CRAY-2, HP-UX f77: as in C.
VAX/VMS FORTRAN, VAX Ultrix fort, IBM RS/6000 xlf: LS Bit = 0/1 = TRUE/FALSE.
Apollo, non CRAY-2 : 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.]*/
#define C2FLOGICALV(A,I) \
do {int __i; for(__i=0;__i<I;__i++) A[__i]=C2FLOGICAL(A[__i]); } while (FALSE)
#define F2CLOGICALV(A,I) \
do {int __i; for(__i=0;__i<I;__i++) A[__i]=F2CLOGICAL(A[__i]); } while (FALSE)
#if defined(apolloFortran) || (defined(CRAYFortran) && !defined(_CRAY2))
#ifndef apolloFortran
#define C2FLOGICAL(L) ((L)?(L)|(1<<sizeof(int)*8-1):(L)&~(1<<sizeof(int)*8-1))
#else
#define C2FLOGICAL(L) ((L)?-1:(L)&~(1<<sizeof(int)*8-1)) /* Apollo Exception */
#endif
#define F2CLOGICAL(L) ((L)<0?(L):0)
#else
#if defined(IBMR2Fortran) || defined(vmsFortran) || defined(DECFortran)
#define C2FLOGICAL(L) ((L)?(L)|1:(L)&~(int)1)
#define F2CLOGICAL(L) ((L)&1?(L):0)
#else /* all other machines evaluate LOGICALs as C does. */
#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
#endif
#ifdef LOGICAL_STRICT
/* Force C2FLOGICAL to generate only the values for either .TRUE. or .FALSE.
This is 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
#if defined(apolloFortran) || (defined(CRAYFortran) && !defined(_CRAY2)) || 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 /* 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++ = ' ';
} 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) *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 = elem_len;
for (num=0; ; num++) {
for (i=0; (int) i<num_term && *strv==(char) term_char; i++,strv++);
if ((int) i==num_term) break;
else strv += elem_len-i;
}
return 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
static int __cfztringv[30]; /* => 30 == MAX # of arg.'s C can pass to a */
#define ZTRINGV_NUM(I) I /* FORTRAN function. */
#define ZTRINGV_ARGF(I) __cfztringv[I]
#define ZTRINGV_ARGS(I) B##I
#define VPPBYTE VPPINT
#define VPPDOUBLE VPPINT
#define VPPFLOAT VPPINT
#define VPPINT( A,B) int B = (int)A; /* For ZSTRINGV_ARGS */
#define VPPLOGICAL(A,B) int *B; /* Returning LOGICAL in FUNn and SUBn.*/
#define VPPLONG VPPINT
#define VPPSHORT VPPINT
#define VCF(TN,I) _INT(3,V,TN,A##I,B##I)
#define VVCF(TN,AI,BI) _INT(3,V,TN,AI,BI)
#define VINT( T,A,B) typeP##T##VVVVVVV B = A;
#define VINTV( T,A,B)
#define VINTVV( T,A,B)
#define VINTVVV( T,A,B)
#define VINTVVVV( T,A,B)
#define VINTVVVVV( T,A,B)
#define VINTVVVVVV( T,A,B)
#define VINTVVVVVVV(T,A,B)
#define VPINT( T,A,B) VP##T(A,B)
#define VPVOID( T,A,B)
#ifdef apolloFortran
#define VROUTINE( T,A,B) void (*B)() = (void (*)())A;
#else
#define VROUTINE( T,A,B)
#endif
#define VSIMPLE( T,A,B)
#ifdef vmsFortran
#define VSTRING( T,A,B) static struct {fstring f; unsigned clen;} B = \
{{0,DSC$K_DTYPE_T,DSC$K_CLASS_S,NULL},0};
#define VPSTRING( T,A,B) static fstring B={0,DSC$K_DTYPE_T,DSC$K_CLASS_S,NULL};
#define VSTRINGV( T,A,B) 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 VPSTRINGV( T,A,B) 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 VSTRING( T,A,B) struct {unsigned short clen, flen;} B;
#define VSTRINGV( T,A,B) struct {char *s, *fs; unsigned flen;} B;
#define VPSTRING( T,A,B) int B;
#define VPSTRINGV( T,A,B) struct {char *fs; unsigned short sizeofA, flen;} B;
#endif
#define VZTRINGV VSTRINGV
#define VPZTRINGV VPSTRINGV
/* 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) STR_##TN(4,A,NAME,I,AI,B##I)
#define ALOGICAL( M,I,A,B) B=C2FLOGICAL(B);
#define APLOGICAL(M,I,A,B) A=C2FLOGICAL(A);
#define ASTRING( M,I,A,B) CSTRING(A,B,sizeof(A))
#define APSTRING( M,I,A,B) CPSTRING(A,B,sizeof(A))
#ifdef vmsFortran
#define AATRINGV( M,I,A,B, sA,filA,silA) \
initfstr(B,malloc((sA)-(filA)),(filA),(silA)-1), \
c2fstrv(A[0],B.dsc$a_pointer,(silA),(sA));
#define APATRINGV(M,I,A,B, sA,filA,silA) \
initfstr(B,A[0],(filA),(silA)-1),c2fstrv(A[0],A[0],(silA),(sA));
#else
#define AATRINGV( M,I,A,B, sA,filA,silA) \
(B.s=malloc((sA)-(filA)),B.fs=c2fstrv(A[0],B.s,(B.flen=(silA)-1)+1,(sA)));
#define APATRINGV(M,I,A,B, sA,filA,silA) \
B.fs=c2fstrv(A[0],A[0],(B.flen=(silA)-1)+1,B.sizeofA=(sA));
#endif
#define ASTRINGV( M,I,A,B) \
AATRINGV( M,I,A,B,sizeof(A),firstindexlength(A),secondindexlength(A))
#define APSTRINGV(M,I,A,B) \
APATRINGV( M,I,A,B,sizeof(A),firstindexlength(A),secondindexlength(A))
#define AZTRINGV( M,I,A,B) AATRINGV( M,I,A,B, \
(M##_ELEMS_##I)*(( M##_ELEMLEN_##I)+1), \
(M##_ELEMS_##I),(M##_ELEMLEN_##I)+1)
#define APZTRINGV(M,I,A,B) APATRINGV( M,I,A,B, \
(M##_ELEMS_##I)*(( M##_ELEMLEN_##I)+1), \
(M##_ELEMS_##I),(M##_ELEMLEN_##I)+1)
#define AAPPBYTE( A,B) &A
#define AAPPDOUBLE( A,B) &A
#define AAPPFLOAT( A,B) PPFLOATVVVVVVV &A
#define AAPPINT( A,B) &A
#define AAPPLOGICAL(A,B) B= &A /* B used to keep a common W table. */
#define AAPPLONG( A,B) &A
#define AAPPSHORT( A,B) &A
#define AACF(TN,AI,I,C) _SEP_(TN,C,COMMA) _INT(3,AA,TN,AI,B##I)
#define AAINT( T,A,B) &B
#define AAINTV( T,A,B) PP##T##VVVVVV A
#define AAINTVV( T,A,B) PP##T##VVVVV A[0]
#define AAINTVVV( T,A,B) PP##T##VVVV A[0][0]
#define AAINTVVVV( T,A,B) PP##T##VVV A[0][0][0]
#define AAINTVVVVV( T,A,B) PP##T##VV A[0][0][0][0]
#define AAINTVVVVVV( T,A,B) PP##T##V A[0][0][0][0][0]
#define AAINTVVVVVVV(T,A,B) PP##T A[0][0][0][0][0][0]
#define AAPINT( T,A,B) AAP##T(A,B)
#define AAPVOID( T,A,B) (void *) A
#ifdef apolloFortran
#define AAROUTINE( T,A,B) &B
#else
#define AAROUTINE( T,A,B) (void(*)())A
#endif
#define AASTRING( T,A,B) CCSTRING(T,A,B)
#define AAPSTRING( T,A,B) CCPSTRING(T,A,B)
#ifdef vmsFortran
#define AASTRINGV( T,A,B) &B
#else
#ifdef CRAYFortran
#define AASTRINGV( T,A,B) _cptofcd(B.fs,B.flen)
#else
#define AASTRINGV( T,A,B) B.fs
#endif
#endif
#define AAPSTRINGV AASTRINGV
#define AAZTRINGV AASTRINGV
#define AAPZTRINGV AASTRINGV
#if defined(vmsFortran) || defined(CRAYFortran)
#define JCF(TN,I)
#else
#define JCF(TN,I) STR_##TN(1,J,B##I, 0,0,0)
#define JLOGICAL( B)
#define JPLOGICAL(B)
#define JSTRING( B) ,B.flen
#define JPSTRING( B) ,B
#define JSTRINGV JSTRING
#define JPSTRINGV JSTRING
#define JZTRINGV JSTRING
#define JPZTRINGV JSTRING
#endif
#define WCF(TN,AN,I) STR_##TN(2,W,AN,B##I, 0,0)
#define WLOGICAL( A,B)
#define WPLOGICAL(A,B) *B=F2CLOGICAL(*B);
#define WSTRING( A,B) (A[B.clen]!='\0'?A[B.clen]='\0':0); /* A?="constnt"*/
#define WPSTRING( A,B) kill_trailing(A,' ');
#ifdef vmsFortran
#define WSTRINGV( A,B) free(B.dsc$a_pointer);
#define WPSTRINGV(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 WSTRINGV( A,B) free(B.s);
#define WPSTRINGV(A,B) vkill_trailing( \
f2cstrv((char*)A,(char*)A,B.flen+1,B.sizeofA), B.flen+1,B.sizeofA,' ');
#endif
#define WZTRINGV WSTRINGV
#define WPZTRINGV WPSTRINGV
#define NCF(TN,I,C) _SEP_(TN,C,COMMA) _INT(2,N,TN,A##I,0)
#define NNCF UUCF
#define NNNCF(TN,I,C) _SEP_(TN,C,COLON) _INT(2,N,TN,A##I,0)
#define NINT( T,A) typeP##T##VVVVVVV * A
#define NINTV( T,A) typeP##T##VVVVVV * A
#define NINTVV( T,A) typeP##T##VVVVV * A
#define NINTVVV( T,A) typeP##T##VVVV * A
#define NINTVVVV( T,A) typeP##T##VVV * A
#define NINTVVVVV( T,A) typeP##T##VV * A
#define NINTVVVVVV( T,A) typeP##T##V * A
#define NINTVVVVVVV(T,A) typeP##T * A
#define NPINT( T,A) type##T##VVVVVVV * A
#define NPVOID( T,A) void * A
#ifdef apolloFortran
#define NROUTINE( T,A) void (**A)()
#else
#define NROUTINE( T,A) void ( *A)()
#endif
#ifdef vmsFortran
#define NSTRING( T,A) fstring * A
#define NSTRINGV( T,A) fstringvector * A
#else
#ifdef CRAYFortran
#define NSTRING( T,A) _fcd A
#define NSTRINGV( T,A) _fcd A
#else
#define NSTRING( T,A) char * A
#define NSTRINGV( T,A) char * A
#endif
#endif
#define NPSTRING( T,A) NSTRING(T,A) /* CRAY insists on arg.'s here. */
#define NPNSTRING( T,A) NSTRING(T,A) /* CRAY insists on arg.'s here. */
#define NPPSTRING( T,A) NSTRING(T,A) /* CRAY insists on arg.'s here. */
#define NSTRVOID( T,A) NSTRING(T,A) /* CRAY insists on arg.'s here. */
#define NPSTRINGV( T,A) NSTRINGV(T,A)
#define NZTRINGV( T,A) NSTRINGV(T,A)
#define NPZTRINGV( T,A) NPSTRINGV(T,A)
/* Note: Prevent compiler warnings, null #define PROTOCCALLSFSUB14/20 after
#include-ing cfortran.h if calling the FORTRAN wrapper within the same
source code where the wrapper is created. */
#ifndef __CF__KnR
#define PROTOCCALLSFSUB0(UN,LN) extern void CFC_(UN,LN)();
#define PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
extern void CFC_(UN,LN)(NCF(T1,1,0) NCF(T2,2,1) NCF(T3,3,1) NCF(T4,4,1) \
NCF(T5,5,1) NCF(T6,6,1) NCF(T7,7,1) NCF(T8,8,1) NCF(T9,9,1) NCF(TA,A,1) \
NCF(TB,B,1) NCF(TC,C,1) NCF(TD,D,1) NCF(TE,E,1) ,...);
#define PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)\
extern void CFC_(UN,LN)(NCF(T1,1,0) NCF(T2,2,1) NCF(T3,3,1) NCF(T4,4,1) \
NCF(T5,5,1) NCF(T6,6,1) NCF(T7,7,1) NCF(T8,8,1) NCF(T9,9,1) NCF(TA,A,1) \
NCF(TB,B,1) NCF(TC,C,1) NCF(TD,D,1) NCF(TE,E,1) NCF(TF,F,1) NCF(TG,G,1) \
NCF(TH,H,1) NCF(TI,I,1) NCF(TJ,J,1) NCF(TK,K,1) ,...);
#else
#define PROTOCCALLSFSUB0( UN,LN)
#define PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
#define PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)
#endif
#ifdef OLD_VAXC /* Allow %CC-I-PARAMNOTUSED. */
#pragma standard
#endif
/* do{...}while(FALSE) allows if(a==b) FORT(); else BORT(); */
#define CCALLSFSUB0(UN,LN) \
do{PROTOCCALLSFSUB0(UN,LN) CFC_(UN,LN)();}while(FALSE)
#define CCALLSFSUB1( UN,LN,T1, A1) \
CCALLSFSUB5 (UN,LN,T1,CF_0,CF_0,CF_0,CF_0,A1,0,0,0,0)
#define CCALLSFSUB2( UN,LN,T1,T2, A1,A2) \
CCALLSFSUB5 (UN,LN,T1,T2,CF_0,CF_0,CF_0,A1,A2,0,0,0)
#define CCALLSFSUB3( UN,LN,T1,T2,T3, A1,A2,A3) \
CCALLSFSUB5 (UN,LN,T1,T2,T3,CF_0,CF_0,A1,A2,A3,0,0)
#define CCALLSFSUB4( UN,LN,T1,T2,T3,T4, A1,A2,A3,A4)\
CCALLSFSUB5 (UN,LN,T1,T2,T3,T4,CF_0,A1,A2,A3,A4,0)
#define CCALLSFSUB5( UN,LN,T1,T2,T3,T4,T5, A1,A2,A3,A4,A5) \
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)
#define CCALLSFSUB6( UN,LN,T1,T2,T3,T4,T5,T6, A1,A2,A3,A4,A5,A6) \
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)
#define CCALLSFSUB7( UN,LN,T1,T2,T3,T4,T5,T6,T7, A1,A2,A3,A4,A5,A6,A7) \
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)
#define CCALLSFSUB8( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8, A1,A2,A3,A4,A5,A6,A7,A8) \
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)
#define CCALLSFSUB9( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,A1,A2,A3,A4,A5,A6,A7,A8,A9)\
CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,0)
#define CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA)\
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)
#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)\
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)
#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)\
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)
#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)\
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)
#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)\
do{VVCF(T1,A1,B1) VVCF(T2,A2,B2) VVCF(T3,A3,B3) VVCF(T4,A4,B4) VVCF(T5,A5,B5) \
VVCF(T6,A6,B6) VVCF(T7,A7,B7) VVCF(T8,A8,B8) VVCF(T9,A9,B9) VVCF(TA,AA,BA) \
VVCF(TB,AB,BB) VVCF(TC,AC,BC) VVCF(TD,AD,BD) VVCF(TE,AE,BE) \
PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
ACF(LN,T1,A1,1) ACF(LN,T2,A2,2) ACF(LN,T3,A3,3) \
ACF(LN,T4,A4,4) ACF(LN,T5,A5,5) ACF(LN,T6,A6,6) ACF(LN,T7,A7,7) \
ACF(LN,T8,A8,8) ACF(LN,T9,A9,9) ACF(LN,TA,AA,A) ACF(LN,TB,AB,B) \
ACF(LN,TC,AC,C) ACF(LN,TD,AD,D) ACF(LN,TE,AE,E) \
CFC_(UN,LN)(AACF(T1,A1,1,0) AACF(T2,A2,2,1) AACF(T3,A3,3,1) \
AACF(T4,A4,4,1) AACF(T5,A5,5,1) AACF(T6,A6,6,1) AACF(T7,A7,7,1) \
AACF(T8,A8,8,1) AACF(T9,A9,9,1) AACF(TA,AA,A,1) AACF(TB,AB,B,1) \
AACF(TC,AC,C,1) AACF(TD,AD,D,1) AACF(TE,AE,E,1) \
JCF(T1,1) JCF(T2,2) JCF(T3,3) JCF(T4,4) JCF(T5,5) JCF(T6,6) JCF(T7,7) \
JCF(T8,8) JCF(T9,9) JCF(TA,A) JCF(TB,B) JCF(TC,C) JCF(TD,D) JCF(TE,E) );\
WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) \
WCF(T6,A6,6) WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,AA,A) \
WCF(TB,AB,B) WCF(TC,AC,C) WCF(TD,AD,D) WCF(TE,AE,E) }while(FALSE)
/* Apollo 6.7, CRAY, Sun, VAX/Ultrix vcc/cc and HP can't hack more than 31 arg's */
#if !(defined(VAXUltrix)&&!defined(__GNUC__)) && !defined(__CF__APOLLO67) && !defined(sun) && !defined(__hpux) && !defined(_CRAY)
#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)\
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)
#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)\
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)
#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)\
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)
#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)\
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)
#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)\
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)
/* PROTOCCALLSFSUB20 is commented out, because it chokes the VAX VMS compiler.
It isn't required since we so far only pass pointers and integers to
FORTRAN routines and these arg.'s aren't promoted to anything else. */
#define CCALLSFSUB20(UN,LN,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) \
do{VVCF(T1,A1,B1) VVCF(T2,A2,B2) VVCF(T3,A3,B3) VVCF(T4,A4,B4) VVCF(T5,A5,B5) \
VVCF(T6,A6,B6) VVCF(T7,A7,B7) VVCF(T8,A8,B8) VVCF(T9,A9,B9) VVCF(TA,AA,BA) \
VVCF(TB,AB,BB) VVCF(TC,AC,BC) VVCF(TD,AD,BD) VVCF(TE,AE,BE) VVCF(TF,AF,BF) \
VVCF(TG,AG,BG) VVCF(TH,AH,BH) VVCF(TI,AI,BI) VVCF(TJ,AJ,BJ) VVCF(TK,AK,BK) \
/* PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)*/\
ACF(LN,T1,A1,1) ACF(LN,T2,A2,2) ACF(LN,T3,A3,3) ACF(LN,T4,A4,4) \
ACF(LN,T5,A5,5) ACF(LN,T6,A6,6) ACF(LN,T7,A7,7) ACF(LN,T8,A8,8) \
ACF(LN,T9,A9,9) ACF(LN,TA,AA,A) ACF(LN,TB,AB,B) ACF(LN,TC,AC,C) \
ACF(LN,TD,AD,D) ACF(LN,TE,AE,E) ACF(LN,TF,AF,F) ACF(LN,TG,AG,G) \
ACF(LN,TH,AH,H) ACF(LN,TI,AI,I) ACF(LN,TJ,AJ,J) ACF(LN,TK,AK,K) \
CFC_(UN,LN)(AACF(T1,A1,1,0) AACF(T2,A2,2,1) AACF(T3,A3,3,1) AACF(T4,A4,4,1) \
AACF(T5,A5,5,1) AACF(T6,A6,6,1) AACF(T7,A7,7,1) AACF(T8,A8,8,1) \
AACF(T9,A9,9,1) AACF(TA,AA,A,1) AACF(TB,AB,B,1) AACF(TC,AC,C,1) \
AACF(TD,AD,D,1) AACF(TE,AE,E,1) AACF(TF,AF,F,1) AACF(TG,AG,G,1) \
AACF(TH,AH,H,1) AACF(TI,AI,I,1) AACF(TJ,AJ,J,1) AACF(TK,AK,K,1) \
JCF(T1,1) JCF(T2,2) JCF(T3,3) JCF(T4,4) JCF(T5,5) JCF(T6,6) JCF(T7,7) \
JCF(T8,8) JCF(T9,9) JCF(TA,A) JCF(TB,B) JCF(TC,C) JCF(TD,D) JCF(TE,E) \
JCF(TF,F) JCF(TG,G) JCF(TH,H) JCF(TI,I) JCF(TJ,J) JCF(TK,K) ); \
WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) WCF(T6,A6,6) \
WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,AA,A) WCF(TB,AB,B) WCF(TC,AC,C) \
WCF(TD,AD,D) WCF(TE,AE,E) WCF(TF,AF,F) WCF(TG,AG,G) WCF(TH,AH,H) WCF(TI,AI,I) \
WCF(TJ,AJ,J) WCF(TK,AK,K) }while(FALSE)
#endif /* Apollo 6.7, CRAY, Sun and HP can't hack more than 31 arg.'s */
/*-------------------------------------------------------------------------*/
/* UTILITIES FOR C TO CALL FORTRAN FUNCTIONS */
/*N.B. PROTOCCALLSFFUNn(..) generates code, whether or not the FORTRAN
function is called. Therefore, especially for creator's of C header files
for large FORTRAN libraries which include many functions, to reduce
compile time and object code size, it may be desirable to create
preprocessor directives to allow users to create code for only those
functions which they use. */
/* The following defines the maximum length string that a function can return.
Of course it may be undefine-d and re-define-d before individual
PROTOCCALLSFFUNn(..) as required. It would also be nice to have this derived
from the individual machines' limits. */
#define MAX_LEN_FORTRAN_FUNCTION_STRING 0x4FE
/* The following defines a character used by CFORTRAN.H to flag the end of a
string coming out of a FORTRAN routine. */
#define CFORTRAN_NON_CHAR 0x7F
#ifdef OLD_VAXC /* Prevent %CC-I-PARAMNOTUSED. */
#pragma nostandard
#endif
#define _SEP_(TN,C,COMMA) __SEP_##C(TN,COMMA)
#define __SEP_0(TN,COMMA)
#define __SEP_1(TN,COMMA) _INT(2,SEP_,TN,COMMA,0)
#define SEP_INT(T,B) A##B
#define SEP_INTV SEP_INT
#define SEP_INTVV SEP_INT
#define SEP_INTVVV SEP_INT
#define SEP_INTVVVV SEP_INT
#define SEP_INTVVVVV SEP_INT
#define SEP_INTVVVVVV SEP_INT
#define SEP_INTVVVVVVV SEP_INT
#define SEP_PINT SEP_INT
#define SEP_PVOID SEP_INT
#define SEP_ROUTINE SEP_INT
#define SEP_SIMPLE SEP_INT
#define SEP_VOID SEP_INT /* Need for FORTRAN calls to C subroutines. */
#define SEP_STRING SEP_INT
#define SEP_STRINGV SEP_INT
#define SEP_PSTRING SEP_INT
#define SEP_PSTRINGV SEP_INT
#define SEP_PNSTRING SEP_INT
#define SEP_PPSTRING SEP_INT
#define SEP_STRVOID SEP_INT
#define SEP_ZTRINGV SEP_INT
#define SEP_PZTRINGV SEP_INT
#if defined(SIGNED_BYTE) || !defined(UNSIGNED_BYTE)
#ifdef OLD_VAXC
#define INTEGER_BYTE char /* Old VAXC barfs on 'signed char' */
#else
#define INTEGER_BYTE signed char /* default */
#endif
#else
#define INTEGER_BYTE unsigned char
#endif
#define typePBYTEVVVVVVV INTEGER_BYTE
#define typePDOUBLEVVVVVVV DOUBLE_PRECISION
#define typePFLOATVVVVVVV float
#define typePINTVVVVVVV int
#define typePLOGICALVVVVVVV int
#define typePLONGVVVVVVV long
#define typePSHORTVVVVVVV short
#define CFARGS0(A,T,W,X,Y,Z) A##T
#define CFARGS1(A,T,W,X,Y,Z) A##T(W)
#define CFARGS2(A,T,W,X,Y,Z) A##T(W,X)
#define CFARGS3(A,T,W,X,Y,Z) A##T(W,X,Y)
#define CFARGS4(A,T,W,X,Y,Z) A##T(W,X,Y,Z)
#define _INT(N,T,I,Y,Z) INT_##I(N,T,I,Y,Z)
#define INT_BYTE INT_DOUBLE
#define INT_DOUBLE( N,A,B,Y,Z) CFARGS##N(A,INT,B,Y,Z,0)
#define INT_FLOAT INT_DOUBLE
#define INT_INT INT_DOUBLE
#define INT_LOGICAL INT_DOUBLE
#define INT_LONG INT_DOUBLE
#define INT_SHORT INT_DOUBLE
#define INT_PBYTE INT_PDOUBLE
#define INT_PDOUBLE( N,A,B,Y,Z) CFARGS##N(A,PINT,B,Y,Z,0)
#define INT_PFLOAT INT_PDOUBLE
#define INT_PINT INT_PDOUBLE
#define INT_PLOGICAL INT_PDOUBLE
#define INT_PLONG INT_PDOUBLE
#define INT_PSHORT INT_PDOUBLE
#define INT_BYTEV INT_DOUBLEV
#define INT_BYTEVV INT_DOUBLEVV
#define INT_BYTEVVV INT_DOUBLEVVV
#define INT_BYTEVVVV INT_DOUBLEVVVV
#define INT_BYTEVVVVV INT_DOUBLEVVVVV
#define INT_BYTEVVVVVV INT_DOUBLEVVVVVV
#define INT_BYTEVVVVVVV INT_DOUBLEVVVVVVV
#define INT_DOUBLEV( N,A,B,Y,Z) CFARGS##N(A,INTV,B,Y,Z,0)
#define INT_DOUBLEVV( N,A,B,Y,Z) CFARGS##N(A,INTVV,B,Y,Z,0)
#define INT_DOUBLEVVV( N,A,B,Y,Z) CFARGS##N(A,INTVVV,B,Y,Z,0)
#define INT_DOUBLEVVVV( N,A,B,Y,Z) CFARGS##N(A,INTVVVV,B,Y,Z,0)
#define INT_DOUBLEVVVVV( N,A,B,Y,Z) CFARGS##N(A,INTVVVVV,B,Y,Z,0)
#define INT_DOUBLEVVVVVV( N,A,B,Y,Z) CFARGS##N(A,INTVVVVVV,B,Y,Z,0)
#define INT_DOUBLEVVVVVVV(N,A,B,Y,Z) CFARGS##N(A,INTVVVVVVV,B,Y,Z,0)
#define INT_FLOATV INT_DOUBLEV
#define INT_FLOATVV INT_DOUBLEVV
#define INT_FLOATVVV INT_DOUBLEVVV
#define INT_FLOATVVVV INT_DOUBLEVVVV
#define INT_FLOATVVVVV INT_DOUBLEVVVVV
#define INT_FLOATVVVVVV INT_DOUBLEVVVVVV
#define INT_FLOATVVVVVVV INT_DOUBLEVVVVVVV
#define INT_INTV INT_DOUBLEV
#define INT_INTVV INT_DOUBLEVV
#define INT_INTVVV INT_DOUBLEVVV
#define INT_INTVVVV INT_DOUBLEVVVV
#define INT_INTVVVVV INT_DOUBLEVVVVV
#define INT_INTVVVVVV INT_DOUBLEVVVVVV
#define INT_INTVVVVVVV INT_DOUBLEVVVVVVV
#define INT_LOGICALV INT_DOUBLEV
#define INT_LOGICALVV INT_DOUBLEVV
#define INT_LOGICALVVV INT_DOUBLEVVV
#define INT_LOGICALVVVV INT_DOUBLEVVVV
#define INT_LOGICALVVVVV INT_DOUBLEVVVVV
#define INT_LOGICALVVVVVV INT_DOUBLEVVVVVV
#define INT_LOGICALVVVVVVV INT_DOUBLEVVVVVVV
#define INT_LONGV INT_DOUBLEV
#define INT_LONGVV INT_DOUBLEVV
#define INT_LONGVVV INT_DOUBLEVVV
#define INT_LONGVVVV INT_DOUBLEVVVV
#define INT_LONGVVVVV INT_DOUBLEVVVVV
#define INT_LONGVVVVVV INT_DOUBLEVVVVVV
#define INT_LONGVVVVVVV INT_DOUBLEVVVVVVV
#define INT_SHORTV INT_DOUBLEV
#define INT_SHORTVV INT_DOUBLEVV
#define INT_SHORTVVV INT_DOUBLEVVV
#define INT_SHORTVVVV INT_DOUBLEVVVV
#define INT_SHORTVVVVV INT_DOUBLEVVVVV
#define INT_SHORTVVVVVV INT_DOUBLEVVVVVV
#define INT_SHORTVVVVVVV INT_DOUBLEVVVVVVV
#define INT_PVOID( N,A,B,Y,Z) CFARGS##N(A,B,B,Y,Z,0)
#define INT_ROUTINE INT_PVOID
/*CRAY coughs on the first, i.e. the usual trouble of not being able to
define macros to macros with arguments. */
/*#define INT_SIMPLE INT_PVOID*/
#define INT_SIMPLE( N,A,B,Y,Z) INT_PVOID(N,A,B,Y,Z)
#define INT_VOID INT_PVOID
#define INT_STRING INT_PVOID
#define INT_STRINGV INT_PVOID
#define INT_PSTRING INT_PVOID
#define INT_PSTRINGV INT_PVOID
#define INT_PNSTRING INT_PVOID
#define INT_PPSTRING INT_PVOID
#define INT_ZTRINGV INT_PVOID
#define INT_PZTRINGV INT_PVOID
#define INT_STRVOID INT_PVOID
#define INT_CF_0( N,A,B,Y,Z)
#define UCF(TN,I,C) _SEP_(TN,C,COMMA) _INT(2,U,TN,A##I,0)
#define UUCF(TN,I,C) _SEP_(TN,C,COMMA) _SEP_(TN,1,I)
#define UUUCF(TN,I,C) _SEP_(TN,C,COLON) _INT(2,U,TN,A##I,0)
#define UINT( T,A) typeP##T##VVVVVVV A
#define UINTV( T,A) typeP##T##VVVVVV *A
#define UINTVV( T,A) typeP##T##VVVVV *A
#define UINTVVV( T,A) typeP##T##VVVV *A
#define UINTVVVV( T,A) typeP##T##VVV *A
#define UINTVVVVV( T,A) typeP##T##VV *A
#define UINTVVVVVV( T,A) typeP##T##V *A
#define UINTVVVVVVV(T,A) typeP##T *A
#define UPINT( T,A) type##T##VVVVVVV *A
#define UPVOID( T,A) void *A
#define UROUTINE( T,A) void (*A)()
#define UVOID( T,A) void A /* Needed for C calls FORTRAN subroutines. */
#define USTRING( T,A) char *A /* via VOID and wrapper. */
#define USTRINGV( T,A) char *A
#define UPSTRING( T,A) char *A
#define UPSTRINGV( T,A) char *A
#define UZTRINGV( T,A) char *A
#define UPZTRINGV( T,A) char *A
/* VOID breaks U into U and UU. */
#define UUINT( T,A) typeP##T##VVVVVVV A
#define UUVOID( T,A) /* Needed for FORTRAN calls C subroutines. */
#define UUSTRING( T,A) char *A
/* Sun and VOID break U into U and PU. */
#define PUBYTE( A) INTEGER_BYTE A
#define PUDOUBLE( A) DOUBLE_PRECISION A
#ifndef sunFortran
#define PUFLOAT( A) float A
#else
#define PUFLOAT( A) FLOATFUNCTIONTYPE A
#endif
#define PUINT( A) int A
#define PULOGICAL( A) int A
#define PULONG( A) long A
#define PUSHORT( A) short A
#define PUSTRING( A) char *A
#define PUVOID( A) void A
#define EBYTE INTEGER_BYTE A0;
#define EDOUBLE DOUBLE_PRECISION A0;
#ifndef sunFortran
#define EFLOAT float A0;
#else
#define EFLOAT float AA0; FLOATFUNCTIONTYPE A0;
#endif
#define EINT int A0;
#define ELOGICAL int A0;
#define ELONG long A0;
#define ESHORT short A0;
#define EVOID
#ifdef vmsFortran
#define ESTRING static char AA0[MAX_LEN_FORTRAN_FUNCTION_STRING+1]; \
static fstring A0 = \
{MAX_LEN_FORTRAN_FUNCTION_STRING,DSC$K_DTYPE_T,DSC$K_CLASS_S,AA0};\
memset(AA0, CFORTRAN_NON_CHAR, MAX_LEN_FORTRAN_FUNCTION_STRING);\
*(AA0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0';
#else
#ifdef CRAYFortran
#define ESTRING static char AA0[MAX_LEN_FORTRAN_FUNCTION_STRING+1]; \
static _fcd A0; *(AA0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0';\
memset(AA0,CFORTRAN_NON_CHAR, MAX_LEN_FORTRAN_FUNCTION_STRING);\
A0 = _cptofcd(AA0,MAX_LEN_FORTRAN_FUNCTION_STRING);
#else
#define ESTRING static char A0[MAX_LEN_FORTRAN_FUNCTION_STRING+1]; \
memset(A0, CFORTRAN_NON_CHAR, \
MAX_LEN_FORTRAN_FUNCTION_STRING); \
*(A0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0';
#endif
#endif
/* ESTRING must use static char. array which is guaranteed to exist after
function returns. */
/* N.B.i) The diff. for 0 (Zero) and >=1 arguments.
ii)That the following create an unmatched bracket, i.e. '(', which
must of course be matched in the call.
iii)Commas must be handled very carefully */
#define GZINT( T,UN,LN) A0=CFC_(UN,LN)(
#define GZVOID( T,UN,LN) CFC_(UN,LN)(
#ifdef vmsFortran
#define GZSTRING( T,UN,LN) CFC_(UN,LN)(&A0
#else
#ifdef CRAYFortran
#define GZSTRING( T,UN,LN) CFC_(UN,LN)( A0
#else
#define GZSTRING( T,UN,LN) CFC_(UN,LN)( A0,MAX_LEN_FORTRAN_FUNCTION_STRING
#endif
#endif
#define GINT GZINT
#define GVOID GZVOID
#define GSTRING( T,UN,LN) GZSTRING(T,UN,LN),
#define PPBYTEVVVVVVV
#define PPINTVVVVVVV /* These complement PPFLOATVVVVVVV. */
#define PPDOUBLEVVVVVVV
#define PPLOGICALVVVVVVV
#define PPLONGVVVVVVV
#define PPSHORTVVVVVVV
#define BCF(TN,AN,C) _SEP_(TN,C,COMMA) _INT(2,B,TN,AN,0)
#define BINT( T,A) (typeP##T##VVVVVVV) A
#define BINTV( T,A) A
#define BINTVV( T,A) (A)[0]
#define BINTVVV( T,A) (A)[0][0]
#define BINTVVVV( T,A) (A)[0][0][0]
#define BINTVVVVV( T,A) (A)[0][0][0][0]
#define BINTVVVVVV( T,A) (A)[0][0][0][0][0]
#define BINTVVVVVVV(T,A) (A)[0][0][0][0][0][0]
#define BPINT( T,A) P##T##VVVVVVV &A
#define BSTRING( T,A) (char *) A
#define BSTRINGV( T,A) (char *) A
#define BPSTRING( T,A) (char *) A
#define BPSTRINGV( T,A) (char *) A
#define BPVOID( T,A) (void *) A
#define BROUTINE( T,A) (void(*)())A
#define BZTRINGV( T,A) (char *) A
#define BPZTRINGV( T,A) (char *) A
#define ZCF(TN,N,AN) _INT(3,Z,TN,N,AN)
#define ZINT( T,I,A) (__cfztringv[I]=(int)A),
#define ZPINT ZINT
#define ZINTV( T,I,A)
#define ZINTVV( T,I,A)
#define ZINTVVV( T,I,A)
#define ZINTVVVV( T,I,A)
#define ZINTVVVVV( T,I,A)
#define ZINTVVVVVV( T,I,A)
#define ZINTVVVVVVV(T,I,A)
#define ZSTRING( T,I,A)
#define ZSTRINGV( T,I,A)
#define ZPSTRING( T,I,A)
#define ZPSTRINGV( T,I,A)
#define ZPVOID( T,I,A)
#define ZROUTINE( T,I,A)
#define ZSIMPLE( T,I,A)
#define ZZTRINGV( T,I,A)
#define ZPZTRINGV( T,I,A)
#define SCF(TN,NAME,I,A) STR_##TN(3,S,NAME,I,A,0)
#define SLOGICAL( M,I,A)
#define SPLOGICAL(M,I,A)
#define SSTRING( M,I,A) ,sizeof(A)
#define SSTRINGV( M,I,A) ,( (unsigned)0xFFFF*firstindexlength(A) \
+secondindexlength(A))
#define SPSTRING( M,I,A) ,sizeof(A)
#define SPSTRINGV SSTRINGV
#define SZTRINGV( M,I,A) ,( (unsigned)0xFFFF*M##_ELEMS_##I \
+M##_ELEMLEN_##I+1)
#define SPZTRINGV SZTRINGV
#define HCF(TN,I) STR_##TN(3,H,COMMA, H,C##I,0)
#define HHCF(TN,I) STR_##TN(3,H,COMMA,HH,C##I,0)
#define HHHCF(TN,I) STR_##TN(3,H,COLON, H,C##I,0)
#define H_CF_SPECIAL unsigned
#define HH_CF_SPECIAL
#define HLOGICAL( S,U,B)
#define HPLOGICAL(S,U,B)
#define HSTRING( S,U,B) A##S U##_CF_SPECIAL B
#define HSTRINGV HSTRING
#define HPSTRING HSTRING
#define HPSTRINGV HSTRING
#define HPNSTRING HSTRING
#define HPPSTRING HSTRING
#define HSTRVOID HSTRING
#define HZTRINGV HSTRING
#define HPZTRINGV HSTRING
#define STR_BYTE( N,T,A,B,C,D)
#define STR_DOUBLE( N,T,A,B,C,D) /* Can't add spaces inside */
#define STR_FLOAT( N,T,A,B,C,D) /* expansion since it screws up */
#define STR_INT( N,T,A,B,C,D) /* macro catenation kludge. */
#define STR_LOGICAL( N,T,A,B,C,D) CFARGS##N(T,LOGICAL,A,B,C,D)
#define STR_LONG( N,T,A,B,C,D)
#define STR_SHORT( N,T,A,B,C,D)
#define STR_BYTEV( N,T,A,B,C,D)
#define STR_BYTEVV( N,T,A,B,C,D)
#define STR_BYTEVVV( N,T,A,B,C,D)
#define STR_BYTEVVVV( N,T,A,B,C,D)
#define STR_BYTEVVVVV( N,T,A,B,C,D)
#define STR_BYTEVVVVVV( N,T,A,B,C,D)
#define STR_BYTEVVVVVVV( N,T,A,B,C,D)
#define STR_DOUBLEV( N,T,A,B,C,D)
#define STR_DOUBLEVV( N,T,A,B,C,D)
#define STR_DOUBLEVVV( N,T,A,B,C,D)
#define STR_DOUBLEVVVV( N,T,A,B,C,D)
#define STR_DOUBLEVVVVV( N,T,A,B,C,D)
#define STR_DOUBLEVVVVVV( N,T,A,B,C,D)
#define STR_DOUBLEVVVVVVV( N,T,A,B,C,D)
#define STR_FLOATV( N,T,A,B,C,D)
#define STR_FLOATVV( N,T,A,B,C,D)
#define STR_FLOATVVV( N,T,A,B,C,D)
#define STR_FLOATVVVV( N,T,A,B,C,D)
#define STR_FLOATVVVVV( N,T,A,B,C,D)
#define STR_FLOATVVVVVV( N,T,A,B,C,D)
#define STR_FLOATVVVVVVV( N,T,A,B,C,D)
#define STR_INTV( N,T,A,B,C,D)
#define STR_INTVV( N,T,A,B,C,D)
#define STR_INTVVV( N,T,A,B,C,D)
#define STR_INTVVVV( N,T,A,B,C,D)
#define STR_INTVVVVV( N,T,A,B,C,D)
#define STR_INTVVVVVV( N,T,A,B,C,D)
#define STR_INTVVVVVVV( N,T,A,B,C,D)
#define STR_LOGICALV( N,T,A,B,C,D)
#define STR_LOGICALVV( N,T,A,B,C,D)
#define STR_LOGICALVVV( N,T,A,B,C,D)
#define STR_LOGICALVVVV( N,T,A,B,C,D)
#define STR_LOGICALVVVVV( N,T,A,B,C,D)
#define STR_LOGICALVVVVVV( N,T,A,B,C,D)
#define STR_LOGICALVVVVVVV(N,T,A,B,C,D)
#define STR_LONGV( N,T,A,B,C,D)
#define STR_LONGVV( N,T,A,B,C,D)
#define STR_LONGVVV( N,T,A,B,C,D)
#define STR_LONGVVVV( N,T,A,B,C,D)
#define STR_LONGVVVVV( N,T,A,B,C,D)
#define STR_LONGVVVVVV( N,T,A,B,C,D)
#define STR_LONGVVVVVVV( N,T,A,B,C,D)
#define STR_SHORTV( N,T,A,B,C,D)
#define STR_SHORTVV( N,T,A,B,C,D)
#define STR_SHORTVVV( N,T,A,B,C,D)
#define STR_SHORTVVVV( N,T,A,B,C,D)
#define STR_SHORTVVVVV( N,T,A,B,C,D)
#define STR_SHORTVVVVVV( N,T,A,B,C,D)
#define STR_SHORTVVVVVVV( N,T,A,B,C,D)
#define STR_PBYTE( N,T,A,B,C,D)
#define STR_PDOUBLE( N,T,A,B,C,D)
#define STR_PFLOAT( N,T,A,B,C,D)
#define STR_PINT( N,T,A,B,C,D)
#define STR_PLOGICAL( N,T,A,B,C,D) CFARGS##N(T,PLOGICAL,A,B,C,D)
#define STR_PLONG( N,T,A,B,C,D)
#define STR_PSHORT( N,T,A,B,C,D)
#define STR_STRING( N,T,A,B,C,D) CFARGS##N(T,STRING,A,B,C,D)
#define STR_PSTRING( N,T,A,B,C,D) CFARGS##N(T,PSTRING,A,B,C,D)
#define STR_STRINGV( N,T,A,B,C,D) CFARGS##N(T,STRINGV,A,B,C,D)
#define STR_PSTRINGV( N,T,A,B,C,D) CFARGS##N(T,PSTRINGV,A,B,C,D)
#define STR_PNSTRING( N,T,A,B,C,D) CFARGS##N(T,PNSTRING,A,B,C,D)
#define STR_PPSTRING( N,T,A,B,C,D) CFARGS##N(T,PPSTRING,A,B,C,D)
#define STR_STRVOID( N,T,A,B,C,D) CFARGS##N(T,STRVOID,A,B,C,D)
#define STR_PVOID( N,T,A,B,C,D)
#define STR_ROUTINE( N,T,A,B,C,D)
#define STR_SIMPLE( N,T,A,B,C,D)
#define STR_ZTRINGV( N,T,A,B,C,D) CFARGS##N(T,ZTRINGV,A,B,C,D)
#define STR_PZTRINGV( N,T,A,B,C,D) CFARGS##N(T,PZTRINGV,A,B,C,D)
#define STR_CF_0( N,T,A,B,C,D)
/* See ACF table comments, which explain why CCF was split into two. */
#define CCF(TN,I) STR_##TN(3,C,A##I,B##I,C##I,0)
#define CLOGICAL( A,B,C) A=C2FLOGICAL( A);
#define CPLOGICAL(A,B,C) *A=C2FLOGICAL(*A);
#ifdef vmsFortran
#define CSTRING( A,B,C) (B.clen=strlen(A),B.f.dsc$a_pointer=A, \
C==sizeof(char*)||C==B.clen+1?B.f.dsc$w_length=B.clen: \
(memset((A)+B.clen,' ',C-B.clen-1),A[B.f.dsc$w_length=C-1]='\0'));
#define CSTRINGV( A,B,C) ( \
initfstr(B, malloc((C/0xFFFF)*(C%0xFFFF-1)), C/0xFFFF, C%0xFFFF-1), \
c2fstrv(A,B.dsc$a_pointer,C%0xFFFF,(C/0xFFFF)*(C%0xFFFF)) );
#define CPSTRING( A,B,C) (B.dsc$w_length=strlen(A),B.dsc$a_pointer=A, \
C==sizeof(char*)?0:(memset((A)+B.dsc$w_length,' ',C-B.dsc$w_length-1), \
A[B.dsc$w_length=C-1]='\0'));
#define CPSTRINGV(A,B,C) (initfstr(B, A, C/0xFFFF, C%0xFFFF-1), \
c2fstrv(A,A,C%0xFFFF,(C/0xFFFF)*(C%0xFFFF)) );
#else
#ifdef CRAYFortran
#define CSTRING( A,B,C) (B.clen=strlen(A), \
C==sizeof(char*)||C==B.clen+1?B.flen=B.clen: \
(memset((A)+B.clen,' ',C-B.clen-1),A[B.flen=C-1]='\0'));
#define CSTRINGV( A,B,C) (B.s=malloc((C/0xFFFF)*(C%0xFFFF-1)), \
c2fstrv(A,B.s,(B.flen=C%0xFFFF-1)+1,(C/0xFFFF)*(C%0xFFFF)));
#define CPSTRING( A,B,C) (B=strlen(A), C==sizeof(char*)?0: \
(memset((A)+B,' ',C-B-1),A[B=C-1]='\0'));
#define CPSTRINGV(A,B,C) c2fstrv(A,A,(B.flen=C%0xFFFF-1)+1, \
B.sizeofA=(C/0xFFFF)*(C%0xFFFF));
#else
#define CSTRING( A,B,C) (B.clen=strlen(A), \
C==sizeof(char*)||C==B.clen+1?B.flen=B.clen: \
(memset((A)+B.clen,' ',C-B.clen-1),A[B.flen=C-1]='\0'));
#define CSTRINGV( A,B,C) (B.s=malloc((C/0xFFFF)*(C%0xFFFF-1)), \
B.fs=c2fstrv(A,B.s,(B.flen=C%0xFFFF-1)+1,(C/0xFFFF)*(C%0xFFFF)));
#define CPSTRING( A,B,C) (B=strlen(A), C==sizeof(char*)?0: \
(memset((A)+B,' ',C-B-1),A[B=C-1]='\0'));
#define CPSTRINGV(A,B,C) B.fs=c2fstrv(A,A,(B.flen=C%0xFFFF-1)+1, \
B.sizeofA=(C/0xFFFF)*(C%0xFFFF));
#endif
#endif
#define CZTRINGV CSTRINGV
#define CPZTRINGV CPSTRINGV
#define CCCBYTE( A,B) &A
#define CCCDOUBLE( A,B) &A
#if !defined(__CF__KnR)
#define CCCFLOAT( A,B) &A
/* Although the VAX doesn't, at least the */
#else /* HP and K&R mips promote float arg.'s of */
#define CCCFLOAT( A,B) &B /* unprototyped functions to double. So we can't */
#endif /* use A here to pass the argument to FORTRAN. */
#define CCCINT( A,B) &A
#define CCCLOGICAL( A,B) &A
#define CCCLONG( A,B) &A
#define CCCSHORT( A,B) &A
#define CCCPBYTE( A,B) A
#define CCCPDOUBLE( A,B) A
#define CCCPFLOAT( A,B) A
#define CCCPINT( A,B) A
#define CCCPLOGICAL(A,B) B=A /* B used to keep a common W table. */
#define CCCPLONG( A,B) A
#define CCCPSHORT( A,B) A
#define CCCF(TN,I,M) _SEP_(TN,M,COMMA) _INT(3,CC,TN,A##I,B##I)
#define CCINT( T,A,B) CCC##T(A,B)
#define CCINTV( T,A,B) A
#define CCINTVV( T,A,B) A
#define CCINTVVV( T,A,B) A
#define CCINTVVVV( T,A,B) A
#define CCINTVVVVV( T,A,B) A
#define CCINTVVVVVV( T,A,B) A
#define CCINTVVVVVVV(T,A,B) A
#define CCPINT( T,A,B) CCC##T(A,B)
#define CCPVOID( T,A,B) A
#ifdef apolloFortran
#define CCROUTINE( T,A,B) &A
#else
#define CCROUTINE( T,A,B) A
#endif
#define CCSIMPLE( T,A,B) A
#ifdef vmsFortran
#define CCSTRING( T,A,B) &B.f
#define CCSTRINGV( T,A,B) &B
#define CCPSTRING( T,A,B) &B
#define CCPSTRINGV( T,A,B) &B
#else
#ifdef CRAYFortran
#define CCSTRING( T,A,B) _cptofcd(A,B.flen)
#define CCSTRINGV( T,A,B) _cptofcd(B.s,B.flen)
#define CCPSTRING( T,A,B) _cptofcd(A,B)
#define CCPSTRINGV( T,A,B) _cptofcd(A,B.flen)
#else
#define CCSTRING( T,A,B) A
#define CCSTRINGV( T,A,B) B.fs
#define CCPSTRING( T,A,B) A
#define CCPSTRINGV( T,A,B) B.fs
#endif
#endif
#define CCZTRINGV CCSTRINGV
#define CCPZTRINGV CCPSTRINGV
#define XBYTE return A0;
#define XDOUBLE return A0;
#ifndef sunFortran
#define XFLOAT return A0;
#else
#define XFLOAT ASSIGNFLOAT(AA0,A0); return AA0;
#endif
#define XINT return A0;
#define XLOGICAL return F2CLOGICAL(A0);
#define XLONG return A0;
#define XSHORT return A0;
#define XVOID return ;
#if defined(vmsFortran) || defined(CRAYFortran)
#define XSTRING return kill_trailing( \
kill_trailing(AA0,CFORTRAN_NON_CHAR),' ');
#else
#define XSTRING return kill_trailing( \
kill_trailing( A0,CFORTRAN_NON_CHAR),' ');
#endif
#define CFFUN(NAME) __cf__##NAME
/* Note that we don't use LN here, but we keep it for consistency. */
#define CCALLSFFUN0(UN,LN) CFFUN(UN)()
#ifdef OLD_VAXC /* Allow %CC-I-PARAMNOTUSED. */
#pragma standard
#endif
#define CCALLSFFUN1( UN,LN,T1, A1) \
CCALLSFFUN5 (UN,LN,T1,CF_0,CF_0,CF_0,CF_0,A1,0,0,0,0)
#define CCALLSFFUN2( UN,LN,T1,T2, A1,A2) \
CCALLSFFUN5 (UN,LN,T1,T2,CF_0,CF_0,CF_0,A1,A2,0,0,0)
#define CCALLSFFUN3( UN,LN,T1,T2,T3, A1,A2,A3) \
CCALLSFFUN5 (UN,LN,T1,T2,T3,CF_0,CF_0,A1,A2,A3,0,0)
#define CCALLSFFUN4( UN,LN,T1,T2,T3,T4, A1,A2,A3,A4)\
CCALLSFFUN5 (UN,LN,T1,T2,T3,T4,CF_0,A1,A2,A3,A4,0)
#define CCALLSFFUN5( UN,LN,T1,T2,T3,T4,T5, A1,A2,A3,A4,A5) \
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)
#define CCALLSFFUN6( UN,LN,T1,T2,T3,T4,T5,T6, A1,A2,A3,A4,A5,A6) \
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)
#define CCALLSFFUN7( UN,LN,T1,T2,T3,T4,T5,T6,T7, A1,A2,A3,A4,A5,A6,A7) \
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)
#define CCALLSFFUN8( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8, A1,A2,A3,A4,A5,A6,A7,A8) \
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)
#define CCALLSFFUN9( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,A1,A2,A3,A4,A5,A6,A7,A8,A9)\
CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,0)
#define CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA)\
(ZCF(T1,1,A1) ZCF(T2,2,A2) ZCF(T3,3,A3) ZCF(T4,4,A4) ZCF(T5,5,A5) \
ZCF(T6,6,A6) ZCF(T7,7,A7) ZCF(T8,8,A8) ZCF(T9,9,A9) ZCF(TA,A,AA) \
(CFFUN(UN)( BCF(T1,A1,0) BCF(T2,A2,1) BCF(T3,A3,1) BCF(T4,A4,1) BCF(T5,A5,1) \
BCF(T6,A6,1) BCF(T7,A7,1) BCF(T8,A8,1) BCF(T9,A9,1) BCF(TA,AA,1) \
SCF(T1,LN,1,A1) SCF(T2,LN,2,A2) SCF(T3,LN,3,A3) SCF(T4,LN,4,A4) \
SCF(T5,LN,5,A5) SCF(T6,LN,6,A6) SCF(T7,LN,7,A7) SCF(T8,LN,8,A8) \
SCF(T9,LN,9,A9) SCF(TA,LN,A,AA))))
/* N.B. Create a separate function instead of using (call function, function
value here) because in order to create the variables needed for the input
arg.'s which may be const.'s one has to do the creation within {}, but these
can never be placed within ()'s. Therefore one must create wrapper functions.
gcc, on the other hand may be able to avoid the wrapper functions. */
/* Prototypes are needed to correctly handle the value returned correctly. N.B.
Can only have prototype arg.'s with difficulty, a la G... table since FORTRAN
functions returning strings have extra arg.'s. Don't bother, since this only
causes a compiler warning to come up when one uses FCALLSCFUNn and CCALLSFFUNn
for the same function in the same source code. Something done by the experts in
debugging only.*/
#define PROTOCCALLSFFUN0(F,UN,LN) \
PU##F( CFC_(UN,LN))(CF_NULL_PROTO); \
static _INT(2,U,F,CFFUN(UN),0)() {E##F _INT(3,GZ,F,UN,LN)); X##F}
#define PROTOCCALLSFFUN1( T0,UN,LN,T1) \
PROTOCCALLSFFUN5 (T0,UN,LN,T1,CF_0,CF_0,CF_0,CF_0)
#define PROTOCCALLSFFUN2( T0,UN,LN,T1,T2) \
PROTOCCALLSFFUN5 (T0,UN,LN,T1,T2,CF_0,CF_0,CF_0)
#define PROTOCCALLSFFUN3( T0,UN,LN,T1,T2,T3) \
PROTOCCALLSFFUN5 (T0,UN,LN,T1,T2,T3,CF_0,CF_0)
#define PROTOCCALLSFFUN4( T0,UN,LN,T1,T2,T3,T4) \
PROTOCCALLSFFUN5 (T0,UN,LN,T1,T2,T3,T4,CF_0)
#define PROTOCCALLSFFUN5( T0,UN,LN,T1,T2,T3,T4,T5) \
PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0)
#define PROTOCCALLSFFUN6( T0,UN,LN,T1,T2,T3,T4,T5,T6) \
PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0)
#define PROTOCCALLSFFUN7( T0,UN,LN,T1,T2,T3,T4,T5,T6,T7) \
PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0)
#define PROTOCCALLSFFUN8( T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \
PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0)
#define PROTOCCALLSFFUN9( T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \
PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0)
/* HP/UX 9.01 cc requires the blank between '_INT(3,G,T0,UN,LN) CCCF(T1,1,0)' */
#ifndef __CF__KnR
#define PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \
PU##T0(CFC_(UN,LN))(CF_NULL_PROTO); \
static _INT(2,U,T0,CFFUN(UN),0)(UCF(T1,1,0) UCF(T2,2,1) UCF(T3,3,1) UCF(T4,4,1) \
UCF(T5,5,1) UCF(T6,6,1) UCF(T7,7,1) UCF(T8,8,1) UCF(T9,9,1) UCF(TA,A,1) \
HCF(T1,1) HCF(T2,2) HCF(T3,3) HCF(T4,4) HCF(T5,5) \
HCF(T6,6) HCF(T7,7) HCF(T8,8) HCF(T9,9) HCF(TA,A) ) \
{VCF(T1,1) VCF(T2,2) VCF(T3,3) VCF(T4,4) VCF(T5,5) \
VCF(T6,6) VCF(T7,7) VCF(T8,8) VCF(T9,9) VCF(TA,A) E##T0 \
CCF(T1,1) CCF(T2,2) CCF(T3,3) CCF(T4,4) CCF(T5,5) \
CCF(T6,6) CCF(T7,7) CCF(T8,8) CCF(T9,9) CCF(TA,A) \
_INT(3,G,T0,UN,LN) CCCF(T1,1,0) CCCF(T2,2,1) CCCF(T3,3,1) CCCF(T4,4,1) CCCF(T5,5,1)\
CCCF(T6,6,1) CCCF(T7,7,1) CCCF(T8,8,1) CCCF(T9,9,1) CCCF(TA,A,1)\
JCF(T1,1) JCF(T2,2) JCF(T3,3) JCF(T4,4) JCF(T5,5) \
JCF(T6,6) JCF(T7,7) JCF(T8,8) JCF(T9,9) JCF(TA,A)); \
WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) \
WCF(T6,A6,6) WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,AA,A) X##T0}
#else
#define PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \
PU##T0(CFC_(UN,LN))(CF_NULL_PROTO); \
static _INT(2,U,T0,CFFUN(UN),0)(UUCF(T1,1,0) UUCF(T2,2,1) UUCF(T3,3,1) UUCF(T4,4,1) \
UUCF(T5,5,1) UUCF(T6,6,1) UUCF(T7,7,1) UUCF(T8,8,1) UUCF(T9,9,1) UUCF(TA,A,1) \
HHCF(T1,1) HHCF(T2,2) HHCF(T3,3) HHCF(T4,4) HHCF(T5,5) \
HHCF(T6,6) HHCF(T7,7) HHCF(T8,8) HHCF(T9,9) HHCF(TA,A)) \
UUUCF(T1,1,0) UUUCF(T2,2,1) UUUCF(T3,3,1) UUUCF(T4,4,1) UUUCF(T5,5,1) \
UUUCF(T6,6,1) UUUCF(T7,7,1) UUUCF(T8,8,1) UUUCF(T9,9,1) UUUCF(TA,A,1) \
HHHCF(T1,1) HHHCF(T2,2) HHHCF(T3,3) HHHCF(T4,4) HHHCF(T5,5) \
HHHCF(T6,6) HHHCF(T7,7) HHHCF(T8,8) HHHCF(T9,9) HHHCF(TA,A); \
{VCF(T1,1) VCF(T2,2) VCF(T3,3) VCF(T4,4) VCF(T5,5) \
VCF(T6,6) VCF(T7,7) VCF(T8,8) VCF(T9,9) VCF(TA,A) E##T0 \
CCF(T1,1) CCF(T2,2) CCF(T3,3) CCF(T4,4) CCF(T5,5) \
CCF(T6,6) CCF(T7,7) CCF(T8,8) CCF(T9,9) CCF(TA,A) \
_INT(3,G,T0,UN,LN) CCCF(T1,1,0) CCCF(T2,2,1) CCCF(T3,3,1) CCCF(T4,4,1) CCCF(T5,5,1)\
CCCF(T6,6,1) CCCF(T7,7,1) CCCF(T8,8,1) CCCF(T9,9,1) CCCF(TA,A,1)\
JCF(T1,1) JCF(T2,2) JCF(T3,3) JCF(T4,4) JCF(T5,5) \
JCF(T6,6) JCF(T7,7) JCF(T8,8) JCF(T9,9) JCF(TA,A) ); \
WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) \
WCF(T6,A6,6) WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,AA,A) X##T0}
#endif
/*-------------------------------------------------------------------------*/
/* UTILITIES FOR FORTRAN TO CALL C ROUTINES */
#ifdef OLD_VAXC /* Prevent %CC-I-PARAMNOTUSED. */
#pragma nostandard
#endif
#if defined(vmsFortran) || defined(CRAYFortran)
#define DCF(TN,I)
#define DDCF(TN,I)
#define DDDCF(TN,I)
#else
#define DCF HCF
#define DDCF HHCF
#define DDDCF HHHCF
#endif
#define QCF(TN,I) STR_##TN(1,Q,B##I, 0,0,0)
#define QLOGICAL( B)
#define QPLOGICAL(B)
#define QSTRINGV( B) char *B; unsigned int B##N;
#define QSTRING( B) char *B=NULL;
#define QPSTRING( B) char *B=NULL;
#define QPSTRINGV QSTRINGV
#define QPNSTRING(B) char *B=NULL;
#define QPPSTRING(B)
#define QSTRVOID( B)
#ifdef apolloFortran
#define ROUTINE_orig (void *)* /* Else, function value has to match. */
#else /* !apolloFortran */
#ifdef __sgi /* Else SGI gives warning 182 contrary to its C LRM A.17.7 */
#define ROUTINE_orig *(void**)&
#else /* !__sgi */
#define ROUTINE_orig (void *)
#endif /* __sgi */
#endif /* apolloFortran */
#define ROUTINE_1 ROUTINE_orig
#define ROUTINE_2 ROUTINE_orig
#define ROUTINE_3 ROUTINE_orig
#define ROUTINE_4 ROUTINE_orig
#define ROUTINE_5 ROUTINE_orig
#define ROUTINE_6 ROUTINE_orig
#define ROUTINE_7 ROUTINE_orig
#define ROUTINE_8 ROUTINE_orig
#define ROUTINE_9 ROUTINE_orig
#define ROUTINE_10 ROUTINE_orig
#define ROUTINE_11 ROUTINE_orig
#define ROUTINE_12 ROUTINE_orig
#define ROUTINE_13 ROUTINE_orig
#define ROUTINE_14 ROUTINE_orig
#define ROUTINE_15 ROUTINE_orig
#define TCF(NAME,TN,I,M) _SEP_(TN,M,COMMA) T##TN(NAME,I,A##I,B##I,C##I)
#define TBYTE( M,I,A,B,D) *A
#define TDOUBLE( M,I,A,B,D) *A
#define TFLOAT( M,I,A,B,D) *A
#define TINT( M,I,A,B,D) *A
#define TLOGICAL( M,I,A,B,D) F2CLOGICAL(*A)
#define TLONG( M,I,A,B,D) *A
#define TSHORT( M,I,A,B,D) *A
#define TBYTEV( M,I,A,B,D) A
#define TDOUBLEV( M,I,A,B,D) A
#define TFLOATV( M,I,A,B,D) VOIDP0 A
#define TINTV( M,I,A,B,D) A
#define TLOGICALV( M,I,A,B,D) A
#define TLONGV( M,I,A,B,D) A
#define TSHORTV( M,I,A,B,D) A
#define TBYTEVV( M,I,A,B,D) (void *)A /* We have to cast to void *, */
#define TBYTEVVV( M,I,A,B,D) (void *)A /* since we don't know the */
#define TBYTEVVVV( M,I,A,B,D) (void *)A /* dimensions of the array. */
#define TBYTEVVVVV( M,I,A,B,D) (void *)A /* i.e. Unfortunately, can't */
#define TBYTEVVVVVV( M,I,A,B,D) (void *)A /* check that the type matches */
#define TBYTEVVVVVVV( M,I,A,B,D) (void *)A /* with the prototype. */
#define TDOUBLEVV( M,I,A,B,D) (void *)A
#define TDOUBLEVVV( M,I,A,B,D) (void *)A
#define TDOUBLEVVVV( M,I,A,B,D) (void *)A
#define TDOUBLEVVVVV( M,I,A,B,D) (void *)A
#define TDOUBLEVVVVVV( M,I,A,B,D) (void *)A
#define TDOUBLEVVVVVVV( M,I,A,B,D) (void *)A
#define TFLOATVV( M,I,A,B,D) (void *)A
#define TFLOATVVV( M,I,A,B,D) (void *)A
#define TFLOATVVVV( M,I,A,B,D) (void *)A
#define TFLOATVVVVV( M,I,A,B,D) (void *)A
#define TFLOATVVVVVV( M,I,A,B,D) (void *)A
#define TFLOATVVVVVVV( M,I,A,B,D) (void *)A
#define TINTVV( M,I,A,B,D) (void *)A
#define TINTVVV( M,I,A,B,D) (void *)A
#define TINTVVVV( M,I,A,B,D) (void *)A
#define TINTVVVVV( M,I,A,B,D) (void *)A
#define TINTVVVVVV( M,I,A,B,D) (void *)A
#define TINTVVVVVVV( M,I,A,B,D) (void *)A
#define TLOGICALVV( M,I,A,B,D) (void *)A
#define TLOGICALVVV( M,I,A,B,D) (void *)A
#define TLOGICALVVVV( M,I,A,B,D) (void *)A
#define TLOGICALVVVVV( M,I,A,B,D) (void *)A
#define TLOGICALVVVVVV( M,I,A,B,D) (void *)A
#define TLOGICALVVVVVVV(M,I,A,B,D) (void *)A
#define TLONGVV( M,I,A,B,D) (void *)A
#define TLONGVVV( M,I,A,B,D) (void *)A
#define TLONGVVVV( M,I,A,B,D) (void *)A
#define TLONGVVVVV( M,I,A,B,D) (void *)A
#define TLONGVVVVVV( M,I,A,B,D) (void *)A
#define TLONGVVVVVVV( M,I,A,B,D) (void *)A
#define TSHORTVV( M,I,A,B,D) (void *)A
#define TSHORTVVV( M,I,A,B,D) (void *)A
#define TSHORTVVVV( M,I,A,B,D) (void *)A
#define TSHORTVVVVV( M,I,A,B,D) (void *)A
#define TSHORTVVVVVV( M,I,A,B,D) (void *)A
#define TSHORTVVVVVVV( M,I,A,B,D) (void *)A
#define TPBYTE( M,I,A,B,D) A
#define TPDOUBLE( M,I,A,B,D) A
#define TPFLOAT( M,I,A,B,D) VOIDP0 A
#define TPINT( M,I,A,B,D) A
#define TPLOGICAL( M,I,A,B,D) ((*A=F2CLOGICAL(*A)),A)
#define TPLONG( M,I,A,B,D) A
#define TPSHORT( M,I,A,B,D) A
#define TPVOID( M,I,A,B,D) A
#define TROUTINE( M,I,A,B,D) ROUTINE_##I A
/* A == pointer to the characters
D == length of the string, or of an element in an array of strings
E == number of elements in an array of strings */
#define TTSTR( A,B,D) \
((B=malloc(D+1))[D]='\0', memcpy(B,A,D), kill_trailing(B,' '))
#define TTTTSTR( A,B,D) (!(D<4||A[0]||A[1]||A[2]||A[3]))?NULL: \
memchr(A,'\0',D) ?A : TTSTR(A,B,D)
#define TTTTSTRV( A,B,D,E) (B##N=E,B=malloc(B##N*(D+1)), (void *) \
vkill_trailing(f2cstrv(A,B,D+1, B##N*(D+1)), D+1,B##N*(D+1),' '))
#ifdef vmsFortran
#define TSTRING( M,I,A,B,D) TTTTSTR( A->dsc$a_pointer,B,A->dsc$w_length)
#define TSTRINGV( M,I,A,B,D) TTTTSTRV(A->dsc$a_pointer, B, \
A->dsc$w_length , A->dsc$l_m[0])
#define TPSTRING( M,I,A,B,D) TTSTR( A->dsc$a_pointer,B,A->dsc$w_length)
#define TPPSTRING( M,I,A,B,D) A->dsc$a_pointer
#define TSTRVOID( M,I,A,B,D) A->dsc$a_pointer,A->dsc$w_length
#else
#ifdef CRAYFortran
#define TSTRING( M,I,A,B,D) TTTTSTR( _fcdtocp(A),B,_fcdlen(A))
#define TSTRINGV( M,I,A,B,D) TTTTSTRV(_fcdtocp(A),B,_fcdlen(A), \
num_elem(_fcdtocp(A),_fcdlen(A),M##_STRV_##A))
#define TPSTRING( M,I,A,B,D) TTSTR( _fcdtocp(A),B,_fcdlen(A))
#define TPPSTRING( M,I,A,B,D) _fcdtocp(A)
#define TSTRVOID( M,I,A,B,D) _fcdtocp(A),_fcdlen(A)
#else
#define TSTRING( M,I,A,B,D) TTTTSTR( A,B,D)
#define TSTRINGV( M,I,A,B,D) TTTTSTRV(A,B,D, \
num_elem(A,D,M##_STRV_##A))
#define TPSTRING( M,I,A,B,D) TTSTR( A,B,D)
#define TPPSTRING( M,I,A,B,D) A
#define TSTRVOID( M,I,A,B,D) A,D
#endif
#endif
#define TPNSTRING TSTRING
#define TPSTRINGV TSTRINGV
#define TCF_0( M,I,A,B,D)
#define RCF(TN,I) STR_##TN(3,R,A##I,B##I,C##I,0)
#define RLOGICAL( A,B,D)
#define RPLOGICAL(A,B,D) *A=C2FLOGICAL(*A);
#define RSTRING( A,B,D) if (B) free(B);
#define RSTRINGV( A,B,D) free(B);
/* A and D as defined above for TSTRING(V) */
#define RRRRPSTR( A,B,D) if (B) memcpy(A,B,PGSMIN(strlen(B),D)), \
(D>strlen(B)?memset(A+strlen(B),' ', D-strlen(B)):0), free(B);
#define RRRRPSTRV(A,B,D) c2fstrv(B,A,D+1,(D+1)*B##N), free(B);
#ifdef vmsFortran
#define RPSTRING( A,B,D) RRRRPSTR( A->dsc$a_pointer,B,A->dsc$w_length)
#define RPSTRINGV(A,B,D) RRRRPSTRV(A->dsc$a_pointer,B,A->dsc$w_length)
#else
#ifdef CRAYFortran
#define RPSTRING( A,B,D) RRRRPSTR( _fcdtocp(A),B,_fcdlen(A))
#define RPSTRINGV(A,B,D) RRRRPSTRV(_fcdtocp(A),B,_fcdlen(A))
#else
#define RPSTRING( A,B,D) RRRRPSTR( A,B,D)
#define RPSTRINGV(A,B,D) RRRRPSTRV(A,B,D)
#endif
#endif
#define RPNSTRING(A,B,D) RPSTRING( A,B,D)
#define RPPSTRING(A,B,D)
#define RSTRVOID( A,B,D)
#define FZBYTE( UN,LN) INTEGER_BYTE fcallsc(UN,LN)(
#define FZDOUBLE( UN,LN) DOUBLE_PRECISION fcallsc(UN,LN)(
#define FZINT( UN,LN) int fcallsc(UN,LN)(
#define FZLOGICAL(UN,LN) int fcallsc(UN,LN)(
#define FZLONG( UN,LN) long fcallsc(UN,LN)(
#define FZSHORT( UN,LN) short fcallsc(UN,LN)(
#define FZVOID( UN,LN) void fcallsc(UN,LN)(
#ifndef __CF__KnR
/* The void is req'd by the Apollo, to make this an ANSI function declaration.
The Apollo promotes K&R float functions to double. */
#define FZFLOAT( UN,LN) float fcallsc(UN,LN)(void
#ifdef vmsFortran
#define FZSTRING( UN,LN) void fcallsc(UN,LN)(fstring *AS
#else
#ifdef CRAYFortran
#define FZSTRING( UN,LN) void fcallsc(UN,LN)(_fcd AS
#else
#define FZSTRING( UN,LN) void fcallsc(UN,LN)(char *AS, unsigned D0
#endif
#endif
#else
#ifndef sunFortran
#define FZFLOAT( UN,LN) float fcallsc(UN,LN)(
#else
#define FZFLOAT( UN,LN) FLOATFUNCTIONTYPE fcallsc(UN,LN)(
#endif
#if defined(vmsFortran) || defined(CRAYFortran)
#define FZSTRING( UN,LN) void fcallsc(UN,LN)(AS
#else
#define FZSTRING( UN,LN) void fcallsc(UN,LN)(AS, D0
#endif
#endif
#define FBYTE FZBYTE
#define FDOUBLE FZDOUBLE
#ifndef __CF_KnR
#define FFLOAT( UN,LN) float fcallsc(UN,LN)(
#else
#define FFLOAT FZFLOAT
#endif
#define FINT FZINT
#define FLOGICAL FZLOGICAL
#define FLONG FZLONG
#define FSHORT FZSHORT
#define FVOID FZVOID
#define FSTRING( UN,LN) FZSTRING(UN,LN),
#define FFINT
#define FFVOID
#ifdef vmsFortran
#define FFSTRING fstring *AS;
#else
#ifdef CRAYFortran
#define FFSTRING _fcd AS;
#else
#define FFSTRING char *AS; unsigned D0;
#endif
#endif
#define LLINT A0=
#define LLSTRING A0=
#define LLVOID
#define KINT
#define KVOID
/* KSTRING copies the string into the position provided by the caller. */
#ifdef vmsFortran
#define KSTRING \
memcpy(AS->dsc$a_pointer,A0, PGSMIN(AS->dsc$w_length,(A0==NULL?0:strlen(A0))) ); \
AS->dsc$w_length>(A0==NULL?0:strlen(A0))? \
memset(AS->dsc$a_pointer+(A0==NULL?0:strlen(A0)),' ', \
AS->dsc$w_length-(A0==NULL?0:strlen(A0))):0;
#else
#ifdef CRAYFortran
#define KSTRING \
memcpy(_fcdtocp(AS),A0, PGSMIN(_fcdlen(AS),(A0==NULL?0:strlen(A0))) ); \
_fcdlen(AS)>(A0==NULL?0:strlen(A0))? \
memset(_fcdtocp(AS)+(A0==NULL?0:strlen(A0)),' ', \
_fcdlen(AS)-(A0==NULL?0:strlen(A0))):0;
#else
#define KSTRING memcpy(AS,A0, PGSMIN(D0,(A0==NULL?0:strlen(A0))) ); \
D0>(A0==NULL?0:strlen(A0))?memset(AS+(A0==NULL?0:strlen(A0)), \
' ', D0-(A0==NULL?0:strlen(A0))):0;
#endif
#endif
/* Note that K.. and I.. can't be combined since K.. has to access data before
R.., in order for functions returning strings which are also passed in as
arguments to work correctly. Note that R.. frees and hence may corrupt the
string. */
#define IBYTE return A0;
#define IDOUBLE return A0;
#ifndef sunFortran
#define IFLOAT return A0;
#else
#define IFLOAT RETURNFLOAT(A0);
#endif
#define IINT return A0;
#define ILOGICAL return C2FLOGICAL(A0);
#define ILONG return A0;
#define ISHORT return A0;
#define ISTRING return ;
#define IVOID return ;
#ifdef OLD_VAXC /* Allow %CC-I-PARAMNOTUSED. */
#pragma standard
#endif
#define FCALLSCSUB0( CN,UN,LN) FCALLSCFUN0(VOID,CN,UN,LN)
#define FCALLSCSUB1( CN,UN,LN,T1) FCALLSCFUN1(VOID,CN,UN,LN,T1)
#define FCALLSCSUB2( CN,UN,LN,T1,T2) FCALLSCFUN2(VOID,CN,UN,LN,T1,T2)
#define FCALLSCSUB3( CN,UN,LN,T1,T2,T3) FCALLSCFUN3(VOID,CN,UN,LN,T1,T2,T3)
#define FCALLSCSUB4( CN,UN,LN,T1,T2,T3,T4) FCALLSCFUN4(VOID,CN,UN,LN,T1,T2,T3,T4)
#define FCALLSCSUB5( CN,UN,LN,T1,T2,T3,T4,T5) \
FCALLSCFUN5(VOID,CN,UN,LN,T1,T2,T3,T4,T5)
#define FCALLSCSUB6( CN,UN,LN,T1,T2,T3,T4,T5,T6) \
FCALLSCFUN6(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6)
#define FCALLSCSUB7( CN,UN,LN,T1,T2,T3,T4,T5,T6,T7) \
FCALLSCFUN7(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7)
#define FCALLSCSUB8( CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \
FCALLSCFUN8(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8)
#define FCALLSCSUB9( CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \
FCALLSCFUN9(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9)
#define FCALLSCSUB10(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \
FCALLSCFUN10(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA)
#define FCALLSCSUB11(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \
FCALLSCFUN11(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB)
#define FCALLSCSUB12(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \
FCALLSCFUN12(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC)
#define FCALLSCSUB13(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \
FCALLSCFUN13(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD)
#define FCALLSCSUB14(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
FCALLSCFUN14(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
#define FCALLSCSUB15(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF) \
FCALLSCFUN15(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF)
#define FCALLSCFUN1( T0,CN,UN,LN,T1) \
FCALLSCFUN5 (T0,CN,UN,LN,T1,CF_0,CF_0,CF_0,CF_0)
#define FCALLSCFUN2( T0,CN,UN,LN,T1,T2) \
FCALLSCFUN5 (T0,CN,UN,LN,T1,T2,CF_0,CF_0,CF_0)
#define FCALLSCFUN3( T0,CN,UN,LN,T1,T2,T3) \
FCALLSCFUN5 (T0,CN,UN,LN,T1,T2,T3,CF_0,CF_0)
#define FCALLSCFUN4( T0,CN,UN,LN,T1,T2,T3,T4) \
FCALLSCFUN5 (T0,CN,UN,LN,T1,T2,T3,T4,CF_0)
#define FCALLSCFUN5( T0,CN,UN,LN,T1,T2,T3,T4,T5)\
FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0)
#define FCALLSCFUN6( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6) \
FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0)
#define FCALLSCFUN7( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7) \
FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0)
#define FCALLSCFUN8( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \
FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0)
#define FCALLSCFUN9( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \
FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0)
#define FCALLSCFUN10( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \
FCALLSCFUN15(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0,CF_0)
#define FCALLSCFUN11( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \
FCALLSCFUN15(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0,CF_0)
#define FCALLSCFUN12( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \
FCALLSCFUN15(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0,CF_0)
#define FCALLSCFUN13( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \
FCALLSCFUN15(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0,CF_0)
#define FCALLSCFUN14( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
FCALLSCFUN15(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,CF_0)
#ifndef __CF__KnR
#define FCALLSCFUN0(T0,CN,UN,LN) \
FZ##T0(UN,LN)) {_INT(2,UU,T0,A0,0); _INT(0,LL,T0,0,0) CN(); _INT(0,K,T0,0,0) I##T0}
#define FCALLSCFUN15(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF) \
F##T0(UN,LN) NCF(T1,1,0) NCF(T2,2,1) NCF(T3,3,1) NCF(T4,4,1) NCF(T5,5,1) \
NCF(T6,6,1) NCF(T7,7,1) NCF(T8,8,1) NCF(T9,9,1) NCF(TA,A,1) \
NCF(TB,B,1) NCF(TC,C,1) NCF(TD,D,1) NCF(TE,E,1) NCF(TF,F,1) \
DCF(T1,1) DCF(T2,2) DCF(T3,3) DCF(T4,4) DCF(T5,5) \
DCF(T6,6) DCF(T7,7) DCF(T8,8) DCF(T9,9) DCF(TA,A) \
DCF(TB,B) DCF(TC,C) DCF(TD,D) DCF(TE,E) DCF(TF,F) ) \
{QCF(T1,1) QCF(T2,2) QCF(T3,3) QCF(T4,4) QCF(T5,5) \
QCF(T6,6) QCF(T7,7) QCF(T8,8) QCF(T9,9) QCF(TA,A) \
QCF(TB,B) QCF(TC,C) QCF(TD,D) QCF(TE,E) QCF(TF,F) _INT(2,UU,T0,A0,0); \
_INT(0,LL,T0,0,0) CN(TCF(LN,T1,1,0) TCF(LN,T2,2,1) TCF(LN,T3,3,1) TCF(LN,T4,4,1) \
TCF(LN,T5,5,1) TCF(LN,T6,6,1) TCF(LN,T7,7,1) TCF(LN,T8,8,1) TCF(LN,T9,9,1) \
TCF(LN,TA,A,1) TCF(LN,TB,B,1) TCF(LN,TC,C,1) TCF(LN,TD,D,1) TCF(LN,TE,E,1) TCF(LN,TF,F,1)); \
_INT(0,K,T0,0,0) RCF(T1,1) RCF(T2,2) RCF(T3,3) RCF(T4,4) \
RCF(T5,5) RCF(T6,6) RCF(T7,7) RCF(T8,8) RCF(T9,9) RCF(TA,A) \
RCF(TB,B) RCF(TC,C) RCF(TD,D) RCF(TE,E) RCF(TF,F) I##T0}
#else
#define FCALLSCFUN0(T0,CN,UN,LN) FZ##T0(UN,LN)) _INT(0,FF,T0,0,0) \
{_INT(2,UU,T0,A0,0); _INT(0,LL,T0,0,0) CN(); _INT(0,K,T0,0,0) I##T0}
#define FCALLSCFUN15(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF) \
F##T0(UN,LN) NNCF(T1,1,0) NNCF(T2,2,1) NNCF(T3,3,1) NNCF(T4,4,1) NNCF(T5,5,1)\
NNCF(T6,6,1) NNCF(T7,7,1) NNCF(T8,8,1) NNCF(T9,9,1) \
NNCF(TA,A,1) NNCF(TB,B,1) NNCF(TC,C,1) NNCF(TD,D,1) NNCF(TE,E,1) NNCF(TF,F,1) \
DDCF(T1,1) DDCF(T2,2) DDCF(T3,3) DDCF(T4,4) DDCF(T5,5) \
DDCF(T6,6) DDCF(T7,7) DDCF(T8,8) DDCF(T9,9) \
DDCF(TA,A) DDCF(TB,B) DDCF(TC,C) DDCF(TD,D) DDCF(TE,E) DDCF(TF,F)) _INT(0,FF,T0,0,0) \
NNNCF(T1,1,0) NNNCF(T2,2,1) NNNCF(T3,3,1) NNNCF(T4,4,1) NNNCF(T5,5,1) \
NNNCF(T6,6,1) NNNCF(T7,7,1) NNNCF(T8,8,1) NNNCF(T9,9,1) \
NNNCF(TA,A,1) NNNCF(TB,B,1) NNNCF(TC,C,1) NNNCF(TD,D,1) NNNCF(TE,E,1) NNNCF(TF,F,1) \
DDDCF(T1,1) DDDCF(T2,2) DDDCF(T3,3) DDDCF(T4,4) DDDCF(T5,5) \
DDDCF(T6,6) DDDCF(T7,7) DDDCF(T8,8) DDDCF(T9,9) \
DDDCF(TA,A) DDDCF(TB,B) DDDCF(TC,C) DDDCF(TD,D) DDDCF(TE,E) DDDCF(TF,F); \
{QCF(T1,1) QCF(T2,2) QCF(T3,3) QCF(T4,4) QCF(T5,5) \
QCF(T6,6) QCF(T7,7) QCF(T8,8) QCF(T9,9) \
QCF(TA,A) QCF(TB,B) QCF(TC,C) QCF(TD,D) QCF(TE,E) QCF(TF,F) _INT(2,UU,T0,A0,0); \
_INT(0,LL,T0,0,0) CN( TCF(LN,T1,1,0) TCF(LN,T2,2,1) TCF(LN,T3,3,1) \
TCF(LN,T4,4,1) TCF(LN,T5,5,1) TCF(LN,T6,6,1) \
TCF(LN,T7,7,1) TCF(LN,T8,8,1) TCF(LN,T9,9,1) \
TCF(LN,TA,A,1) TCF(LN,TB,B,1) TCF(LN,TC,C,1) TCF(LN,TD,D,1) TCF(LN,TE,E,1) TCF(LN,TF,F,1)); \
_INT(0,K,T0,0,0) RCF(T1,1) RCF(T2,2) RCF(T3,3) RCF(T4,4) RCF(T5,5) \
RCF(T6,6) RCF(T7,7) RCF(T8,8) RCF(T9,9) \
RCF(TA,A) RCF(TB,B) RCF(TC,C) RCF(TD,D) RCF(TE,E) RCF(TF,F) I##T0}
#endif
#endif /* VAX VMS or Ultrix, Mips, CRAY, Sun, Apollo, HP9000, LynxOS, IBMR2.
f2c, NAG f90. */
#ifdef __cplusplus
}
#endif
|