![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to F77a.st CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / f2c|
Return to F77a.st CVS log | Up to [Research Unix] / researchv10no / cmd / f2c |
1.1 ! root 1: ./ ADD NAME=Version.c TIME=699256367 ! 2: static char junk[] = "\n@(#)LIBF77 VERSION 2.01 28 Feb. 1992\n"; ! 3: ! 4: /* ! 5: 2.00 11 June 1980. File version.c added to library. ! 6: 2.01 31 May 1988. s_paus() flushes stderr; names of hl_* fixed ! 7: [ d]erf[c ] added ! 8: 8 Aug. 1989: #ifdefs for f2c -i2 added to s_cat.c ! 9: 29 Nov. 1989: s_cmp returns long (for f2c) ! 10: 30 Nov. 1989: arg types from f2c.h ! 11: 12 Dec. 1989: s_rnge allows long names ! 12: 19 Dec. 1989: getenv_ allows unsorted environment ! 13: 28 Mar. 1990: add exit(0) to end of main() ! 14: 2 Oct. 1990: test signal(...) == SIG_IGN rather than & 01 in main ! 15: 17 Oct. 1990: abort() calls changed to sig_die(...,1) ! 16: 22 Oct. 1990: separate sig_die from main ! 17: 25 Apr. 1991: minor, theoretically invisible tweaks to s_cat, sig_die ! 18: 31 May 1991: make system_ return status ! 19: 18 Dec. 1991: change long to ftnlen (for -i2) many places ! 20: 28 Feb. 1992: repair z_sqrt.c (scribbled on input, gave wrong answer) ! 21: */ ! 22: ./ ADD NAME=abort_.c TIME=708871716 ! 23: #include "stdio.h" ! 24: #include "f2c.h" ! 25: ! 26: #ifdef KR_headers ! 27: extern VOID sig_die(); ! 28: ! 29: VOID abort_() ! 30: #else ! 31: extern void sig_die(char*,int); ! 32: ! 33: void abort_(void) ! 34: #endif ! 35: { ! 36: sig_die("Fortran abort routine called", 1); ! 37: } ! 38: ./ ADD NAME=c_abs.c TIME=708960773 ! 39: #include "f2c.h" ! 40: ! 41: #ifdef KR_headers ! 42: extern double Cabs(); ! 43: ! 44: double c_abs(z) complex *z; ! 45: #else ! 46: extern double Cabs(double, double); ! 47: ! 48: double c_abs(complex *z) ! 49: #endif ! 50: { ! 51: return( Cabs( z->r, z->i ) ); ! 52: } ! 53: ./ ADD NAME=c_cos.c TIME=708889712 ! 54: #include "f2c.h" ! 55: ! 56: #ifdef KR_headers ! 57: extern double sin(), cos(), sinh(), cosh(); ! 58: ! 59: VOID c_cos(r, z) complex *r, *z; ! 60: #else ! 61: #undef abs ! 62: #include "math.h" ! 63: ! 64: void c_cos(complex *r, complex *z) ! 65: #endif ! 66: { ! 67: r->r = cos(z->r) * cosh(z->i); ! 68: r->i = - sin(z->r) * sinh(z->i); ! 69: } ! 70: ./ ADD NAME=c_div.c TIME=708872168 ! 71: #include "f2c.h" ! 72: ! 73: #ifdef KR_headers ! 74: extern VOID sig_die(); ! 75: VOID c_div(c, a, b) ! 76: complex *a, *b, *c; ! 77: #else ! 78: extern void sig_die(char*,int); ! 79: void c_div(complex *c, complex *a, complex *b) ! 80: #endif ! 81: { ! 82: double ratio, den; ! 83: double abr, abi; ! 84: ! 85: if( (abr = b->r) < 0.) ! 86: abr = - abr; ! 87: if( (abi = b->i) < 0.) ! 88: abi = - abi; ! 89: if( abr <= abi ) ! 90: { ! 91: if(abi == 0) ! 92: sig_die("complex division by zero", 1); ! 93: ratio = (double)b->r / b->i ; ! 94: den = b->i * (1 + ratio*ratio); ! 95: c->r = (a->r*ratio + a->i) / den; ! 96: c->i = (a->i*ratio - a->r) / den; ! 97: } ! 98: ! 99: else ! 100: { ! 101: ratio = (double)b->i / b->r ; ! 102: den = b->r * (1 + ratio*ratio); ! 103: c->r = (a->r + a->i*ratio) / den; ! 104: c->i = (a->i - a->r*ratio) / den; ! 105: } ! 106: } ! 107: ./ ADD NAME=c_exp.c TIME=708889712 ! 108: #include "f2c.h" ! 109: ! 110: #ifdef KR_headers ! 111: extern double exp(), cos(), sin(); ! 112: ! 113: VOID c_exp(r, z) complex *r, *z; ! 114: #else ! 115: #undef abs ! 116: #include "math.h" ! 117: ! 118: void c_exp(complex *r, complex *z) ! 119: #endif ! 120: { ! 121: double expx; ! 122: ! 123: expx = exp(z->r); ! 124: r->r = expx * cos(z->i); ! 125: r->i = expx * sin(z->i); ! 126: } ! 127: ./ ADD NAME=c_log.c TIME=708960882 ! 128: #include "f2c.h" ! 129: ! 130: #ifdef KR_headers ! 131: extern double log(), Cabs(), atan2(); ! 132: VOID c_log(r, z) complex *r, *z; ! 133: #else ! 134: #undef abs ! 135: #include "math.h" ! 136: extern double Cabs(double, double); ! 137: ! 138: void c_log(complex *r, complex *z) ! 139: #endif ! 140: { ! 141: r->i = atan2(z->i, z->r); ! 142: r->r = log( Cabs(z->r, z->i) ); ! 143: } ! 144: ./ ADD NAME=c_sin.c TIME=708889712 ! 145: #include "f2c.h" ! 146: ! 147: #ifdef KR_headers ! 148: extern double sin(), cos(), sinh(), cosh(); ! 149: ! 150: VOID c_sin(r, z) complex *r, *z; ! 151: #else ! 152: #undef abs ! 153: #include "math.h" ! 154: ! 155: void c_sin(complex *r, complex *z) ! 156: #endif ! 157: { ! 158: r->r = sin(z->r) * cosh(z->i); ! 159: r->i = cos(z->r) * sinh(z->i); ! 160: } ! 161: ./ ADD NAME=c_sqrt.c TIME=708960905 ! 162: #include "f2c.h" ! 163: ! 164: #ifdef KR_headers ! 165: extern double sqrt(), Cabs(); ! 166: ! 167: VOID c_sqrt(r, z) complex *r, *z; ! 168: #else ! 169: #undef abs ! 170: #include "math.h" ! 171: extern double Cabs(double, double); ! 172: ! 173: void c_sqrt(complex *r, complex *z) ! 174: #endif ! 175: { ! 176: double mag, t; ! 177: ! 178: if( (mag = Cabs(z->r, z->i)) == 0.) ! 179: r->r = r->i = 0.; ! 180: else if(z->r > 0) ! 181: { ! 182: r->r = t = sqrt(0.5 * (mag + z->r) ); ! 183: t = z->i / t; ! 184: r->i = 0.5 * t; ! 185: } ! 186: else ! 187: { ! 188: t = sqrt(0.5 * (mag - z->r) ); ! 189: if(z->i < 0) ! 190: t = -t; ! 191: r->i = t; ! 192: t = z->i / t; ! 193: r->r = 0.5 * t; ! 194: } ! 195: } ! 196: ./ ADD NAME=cabs.c TIME=708960702 ! 197: #ifdef KR_headers ! 198: extern double sqrt(); ! 199: double Cabs(real, imag) double real, imag; ! 200: #else ! 201: #undef abs ! 202: #include "math.h" ! 203: double Cabs(double real, double imag) ! 204: #endif ! 205: { ! 206: double temp; ! 207: ! 208: if(real < 0) ! 209: real = -real; ! 210: if(imag < 0) ! 211: imag = -imag; ! 212: if(imag > real){ ! 213: temp = real; ! 214: real = imag; ! 215: imag = temp; ! 216: } ! 217: if((real+imag) == real) ! 218: return(real); ! 219: ! 220: temp = imag/real; ! 221: temp = real*sqrt(1.0 + temp*temp); /*overflow!!*/ ! 222: return(temp); ! 223: } ! 224: ./ ADD NAME=d_abs.c TIME=708873064 ! 225: #include "f2c.h" ! 226: ! 227: #ifdef KR_headers ! 228: double d_abs(x) doublereal *x; ! 229: #else ! 230: double d_abs(doublereal *x) ! 231: #endif ! 232: { ! 233: if(*x >= 0) ! 234: return(*x); ! 235: return(- *x); ! 236: } ! 237: ./ ADD NAME=d_acos.c TIME=708889712 ! 238: #include "f2c.h" ! 239: ! 240: #ifdef KR_headers ! 241: double acos(); ! 242: double d_acos(x) doublereal *x; ! 243: #else ! 244: #undef abs ! 245: #include "math.h" ! 246: double d_acos(doublereal *x) ! 247: #endif ! 248: { ! 249: return( acos(*x) ); ! 250: } ! 251: ./ ADD NAME=d_asin.c TIME=708889712 ! 252: #include "f2c.h" ! 253: ! 254: #ifdef KR_headers ! 255: double asin(); ! 256: double d_asin(x) doublereal *x; ! 257: #else ! 258: #undef abs ! 259: #include "math.h" ! 260: double d_asin(doublereal *x) ! 261: #endif ! 262: { ! 263: return( asin(*x) ); ! 264: } ! 265: ./ ADD NAME=d_atan.c TIME=708889712 ! 266: #include "f2c.h" ! 267: ! 268: #ifdef KR_headers ! 269: double atan(); ! 270: double d_atan(x) doublereal *x; ! 271: #else ! 272: #undef abs ! 273: #include "math.h" ! 274: double d_atan(doublereal *x) ! 275: #endif ! 276: { ! 277: return( atan(*x) ); ! 278: } ! 279: ./ ADD NAME=d_atn2.c TIME=708889712 ! 280: #include "f2c.h" ! 281: ! 282: #ifdef KR_headers ! 283: double atan2(); ! 284: double d_atn2(x,y) doublereal *x, *y; ! 285: #else ! 286: #undef abs ! 287: #include "math.h" ! 288: double d_atn2(doublereal *x, doublereal *y) ! 289: #endif ! 290: { ! 291: return( atan2(*x,*y) ); ! 292: } ! 293: ./ ADD NAME=d_cnjg.c TIME=708873825 ! 294: #include "f2c.h" ! 295: ! 296: VOID ! 297: #ifdef KR_headers ! 298: d_cnjg(r, z) doublecomplex *r, *z; ! 299: #else ! 300: d_cnjg(doublecomplex *r, doublecomplex *z) ! 301: #endif ! 302: { ! 303: r->r = z->r; ! 304: r->i = - z->i; ! 305: } ! 306: ./ ADD NAME=d_cos.c TIME=708889712 ! 307: #include "f2c.h" ! 308: ! 309: #ifdef KR_headers ! 310: double cos(); ! 311: double d_cos(x) doublereal *x; ! 312: #else ! 313: #undef abs ! 314: #include "math.h" ! 315: double d_cos(doublereal *x) ! 316: #endif ! 317: { ! 318: return( cos(*x) ); ! 319: } ! 320: ./ ADD NAME=d_cosh.c TIME=708889712 ! 321: #include "f2c.h" ! 322: ! 323: #ifdef KR_headers ! 324: double cosh(); ! 325: double d_cosh(x) doublereal *x; ! 326: #else ! 327: #undef abs ! 328: #include "math.h" ! 329: double d_cosh(doublereal *x) ! 330: #endif ! 331: { ! 332: return( cosh(*x) ); ! 333: } ! 334: ./ ADD NAME=d_dim.c TIME=708874152 ! 335: #include "f2c.h" ! 336: ! 337: #ifdef KR_headers ! 338: double d_dim(a,b) doublereal *a, *b; ! 339: #else ! 340: double d_dim(doublereal *a, doublereal *b) ! 341: #endif ! 342: { ! 343: return( *a > *b ? *a - *b : 0); ! 344: } ! 345: ./ ADD NAME=d_exp.c TIME=708889712 ! 346: #include "f2c.h" ! 347: ! 348: #ifdef KR_headers ! 349: double exp(); ! 350: double d_exp(x) doublereal *x; ! 351: #else ! 352: #undef abs ! 353: #include "math.h" ! 354: double d_exp(doublereal *x) ! 355: #endif ! 356: { ! 357: return( exp(*x) ); ! 358: } ! 359: ./ ADD NAME=d_imag.c TIME=708874254 ! 360: #include "f2c.h" ! 361: ! 362: #ifdef KR_headers ! 363: double d_imag(z) doublecomplex *z; ! 364: #else ! 365: double d_imag(doublecomplex *z) ! 366: #endif ! 367: { ! 368: return(z->i); ! 369: } ! 370: ./ ADD NAME=d_int.c TIME=708889712 ! 371: #include "f2c.h" ! 372: ! 373: #ifdef KR_headers ! 374: double floor(); ! 375: double d_int(x) doublereal *x; ! 376: #else ! 377: #undef abs ! 378: #include "math.h" ! 379: double d_int(doublereal *x) ! 380: #endif ! 381: { ! 382: return( (*x>0) ? floor(*x) : -floor(- *x) ); ! 383: } ! 384: ./ ADD NAME=d_lg10.c TIME=708889712 ! 385: #include "f2c.h" ! 386: ! 387: #define log10e 0.43429448190325182765 ! 388: ! 389: #ifdef KR_headers ! 390: double log(); ! 391: double d_lg10(x) doublereal *x; ! 392: #else ! 393: #undef abs ! 394: #include "math.h" ! 395: double d_lg10(doublereal *x) ! 396: #endif ! 397: { ! 398: return( log10e * log(*x) ); ! 399: } ! 400: ./ ADD NAME=d_log.c TIME=708889712 ! 401: #include "f2c.h" ! 402: ! 403: #ifdef KR_headers ! 404: double log(); ! 405: double d_log(x) doublereal *x; ! 406: #else ! 407: #undef abs ! 408: #include "math.h" ! 409: double d_log(doublereal *x) ! 410: #endif ! 411: { ! 412: return( log(*x) ); ! 413: } ! 414: ./ ADD NAME=d_mod.c TIME=708889713 ! 415: #include "f2c.h" ! 416: ! 417: #ifdef KR_headers ! 418: #ifdef IEEE_drem ! 419: double drem(); ! 420: #else ! 421: double floor(); ! 422: #endif ! 423: double d_mod(x,y) doublereal *x, *y; ! 424: #else ! 425: #ifdef IEEE_drem ! 426: double drem(double, double); ! 427: #else ! 428: #undef abs ! 429: #include "math.h" ! 430: #endif ! 431: double d_mod(doublereal *x, doublereal *y) ! 432: #endif ! 433: { ! 434: #ifdef IEEE_drem ! 435: double xa, ya, z; ! 436: if ((ya = *y) < 0.) ! 437: ya = -ya; ! 438: z = drem(xa = *x, ya); ! 439: if (xa > 0) { ! 440: if (z < 0) ! 441: z += ya; ! 442: } ! 443: else if (z > 0) ! 444: z -= ya; ! 445: return z; ! 446: #else ! 447: double quotient; ! 448: if( (quotient = *x / *y) >= 0) ! 449: quotient = floor(quotient); ! 450: else ! 451: quotient = -floor(-quotient); ! 452: return(*x - (*y) * quotient ); ! 453: #endif ! 454: } ! 455: ./ ADD NAME=d_nint.c TIME=708889713 ! 456: #include "f2c.h" ! 457: ! 458: #ifdef KR_headers ! 459: double floor(); ! 460: double d_nint(x) doublereal *x; ! 461: #else ! 462: #undef abs ! 463: #include "math.h" ! 464: double d_nint(doublereal *x) ! 465: #endif ! 466: { ! 467: return( (*x)>=0 ? ! 468: floor(*x + .5) : -floor(.5 - *x) ); ! 469: } ! 470: ./ ADD NAME=d_prod.c TIME=708874891 ! 471: #include "f2c.h" ! 472: ! 473: #ifdef KR_headers ! 474: double d_prod(x,y) real *x, *y; ! 475: #else ! 476: double d_prod(real *x, real *y) ! 477: #endif ! 478: { ! 479: return( (*x) * (*y) ); ! 480: } ! 481: ./ ADD NAME=d_sign.c TIME=708874925 ! 482: #include "f2c.h" ! 483: ! 484: #ifdef KR_headers ! 485: double d_sign(a,b) doublereal *a, *b; ! 486: #else ! 487: double d_sign(doublereal *a, doublereal *b) ! 488: #endif ! 489: { ! 490: double x; ! 491: x = (*a >= 0 ? *a : - *a); ! 492: return( *b >= 0 ? x : -x); ! 493: } ! 494: ./ ADD NAME=d_sin.c TIME=708889713 ! 495: #include "f2c.h" ! 496: ! 497: #ifdef KR_headers ! 498: double sin(); ! 499: double d_sin(x) doublereal *x; ! 500: #else ! 501: #undef abs ! 502: #include "math.h" ! 503: double d_sin(doublereal *x) ! 504: #endif ! 505: { ! 506: return( sin(*x) ); ! 507: } ! 508: ./ ADD NAME=d_sinh.c TIME=708889713 ! 509: #include "f2c.h" ! 510: ! 511: #ifdef KR_headers ! 512: double sinh(); ! 513: double d_sinh(x) doublereal *x; ! 514: #else ! 515: #undef abs ! 516: #include "math.h" ! 517: double d_sinh(doublereal *x) ! 518: #endif ! 519: { ! 520: return( sinh(*x) ); ! 521: } ! 522: ./ ADD NAME=d_sqrt.c TIME=708889713 ! 523: #include "f2c.h" ! 524: ! 525: #ifdef KR_headers ! 526: double sqrt(); ! 527: double d_sqrt(x) doublereal *x; ! 528: #else ! 529: #undef abs ! 530: #include "math.h" ! 531: double d_sqrt(doublereal *x) ! 532: #endif ! 533: { ! 534: return( sqrt(*x) ); ! 535: } ! 536: ./ ADD NAME=d_tan.c TIME=708889713 ! 537: #include "f2c.h" ! 538: ! 539: #ifdef KR_headers ! 540: double tan(); ! 541: double d_tan(x) doublereal *x; ! 542: #else ! 543: #undef abs ! 544: #include "math.h" ! 545: double d_tan(doublereal *x) ! 546: #endif ! 547: { ! 548: return( tan(*x) ); ! 549: } ! 550: ./ ADD NAME=d_tanh.c TIME=708889713 ! 551: #include "f2c.h" ! 552: ! 553: #ifdef KR_headers ! 554: double tanh(); ! 555: double d_tanh(x) doublereal *x; ! 556: #else ! 557: #undef abs ! 558: #include "math.h" ! 559: double d_tanh(doublereal *x) ! 560: #endif ! 561: { ! 562: return( tanh(*x) ); ! 563: } ! 564: ./ ADD NAME=derf_.c TIME=708875112 ! 565: #include "f2c.h" ! 566: ! 567: #ifdef KR_headers ! 568: double erf(); ! 569: double derf_(x) doublereal *x; ! 570: #else ! 571: extern double erf(double); ! 572: double derf_(doublereal *x) ! 573: #endif ! 574: { ! 575: return( erf(*x) ); ! 576: } ! 577: ./ ADD NAME=derfc_.c TIME=708873008 ! 578: #include "f2c.h" ! 579: ! 580: #ifdef KR_headers ! 581: extern double erfc(); ! 582: ! 583: double derfc_(x) doublereal *x; ! 584: #else ! 585: extern double erfc(double); ! 586: ! 587: double derfc_(doublereal *x) ! 588: #endif ! 589: { ! 590: return( erfc(*x) ); ! 591: } ! 592: ./ ADD NAME=ef1asc_.c TIME=708875832 ! 593: /* EFL support routine to copy string b to string a */ ! 594: ! 595: #include "f2c.h" ! 596: ! 597: ! 598: #define M ( (long) (sizeof(long) - 1) ) ! 599: #define EVEN(x) ( ( (x)+ M) & (~M) ) ! 600: ! 601: #ifdef KR_headers ! 602: extern VOID s_copy(); ! 603: VOID ef1asc_(a, la, b, lb) ftnint *a, *b; ftnlen *la, *lb; ! 604: #else ! 605: extern void s_copy(char*,char*,ftnlen,ftnlen); ! 606: void ef1asc_(ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb) ! 607: #endif ! 608: { ! 609: s_copy( (char *)a, (char *)b, EVEN(*la), *lb ); ! 610: } ! 611: ./ ADD NAME=ef1cmc_.c TIME=708876086 ! 612: /* EFL support routine to compare two character strings */ ! 613: ! 614: #include "f2c.h" ! 615: ! 616: #ifdef KR_headers ! 617: extern integer s_cmp(); ! 618: integer ef1cmc_(a, la, b, lb) ftnint *a, *b; ftnlen *la, *lb; ! 619: #else ! 620: extern integer s_cmp(char*,char*,ftnlen,ftnlen); ! 621: integer ef1cmc_(ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb) ! 622: #endif ! 623: { ! 624: return( s_cmp( (char *)a, (char *)b, *la, *lb) ); ! 625: } ! 626: ./ ADD NAME=erf_.c TIME=708875594 ! 627: #include "f2c.h" ! 628: ! 629: #ifdef KR_headers ! 630: double erf(); ! 631: double erf_(x) real *x; ! 632: #else ! 633: extern double erf(double); ! 634: double erf_(real *x) ! 635: #endif ! 636: { ! 637: return( erf(*x) ); ! 638: } ! 639: ./ ADD NAME=erfc_.c TIME=708875664 ! 640: #include "f2c.h" ! 641: ! 642: #ifdef KR_headers ! 643: double erfc(); ! 644: double erfc_(x) real *x; ! 645: #else ! 646: extern double erfc(double); ! 647: double erfc_(real *x) ! 648: #endif ! 649: { ! 650: return( erfc(*x) ); ! 651: } ! 652: ./ ADD NAME=f2c.h TIME=708964532 ! 653: /* f2c.h -- Standard Fortran to C header file */ ! 654: ! 655: /** barf [ba:rf] 2. "He suggested using FORTRAN, and everybody barfed." ! 656: ! 657: - From The Shogakukan DICTIONARY OF NEW ENGLISH (Second edition) */ ! 658: ! 659: #ifndef F2C_INCLUDE ! 660: #define F2C_INCLUDE ! 661: ! 662: typedef long int integer; ! 663: typedef char *address; ! 664: typedef short int shortint; ! 665: typedef float real; ! 666: typedef double doublereal; ! 667: typedef struct { real r, i; } complex; ! 668: typedef struct { doublereal r, i; } doublecomplex; ! 669: typedef long int logical; ! 670: typedef short int shortlogical; ! 671: ! 672: #define TRUE_ (1) ! 673: #define FALSE_ (0) ! 674: ! 675: /* Extern is for use with -E */ ! 676: #ifndef Extern ! 677: #define Extern extern ! 678: #endif ! 679: ! 680: /* I/O stuff */ ! 681: ! 682: #ifdef f2c_i2 ! 683: /* for -i2 */ ! 684: typedef short flag; ! 685: typedef short ftnlen; ! 686: typedef short ftnint; ! 687: #else ! 688: typedef long flag; ! 689: typedef long ftnlen; ! 690: typedef long ftnint; ! 691: #endif ! 692: ! 693: /*external read, write*/ ! 694: typedef struct ! 695: { flag cierr; ! 696: ftnint ciunit; ! 697: flag ciend; ! 698: char *cifmt; ! 699: ftnint cirec; ! 700: } cilist; ! 701: ! 702: /*internal read, write*/ ! 703: typedef struct ! 704: { flag icierr; ! 705: char *iciunit; ! 706: flag iciend; ! 707: char *icifmt; ! 708: ftnint icirlen; ! 709: ftnint icirnum; ! 710: } icilist; ! 711: ! 712: /*open*/ ! 713: typedef struct ! 714: { flag oerr; ! 715: ftnint ounit; ! 716: char *ofnm; ! 717: ftnlen ofnmlen; ! 718: char *osta; ! 719: char *oacc; ! 720: char *ofm; ! 721: ftnint orl; ! 722: char *oblnk; ! 723: } olist; ! 724: ! 725: /*close*/ ! 726: typedef struct ! 727: { flag cerr; ! 728: ftnint cunit; ! 729: char *csta; ! 730: } cllist; ! 731: ! 732: /*rewind, backspace, endfile*/ ! 733: typedef struct ! 734: { flag aerr; ! 735: ftnint aunit; ! 736: } alist; ! 737: ! 738: /* inquire */ ! 739: typedef struct ! 740: { flag inerr; ! 741: ftnint inunit; ! 742: char *infile; ! 743: ftnlen infilen; ! 744: ftnint *inex; /*parameters in standard's order*/ ! 745: ftnint *inopen; ! 746: ftnint *innum; ! 747: ftnint *innamed; ! 748: char *inname; ! 749: ftnlen innamlen; ! 750: char *inacc; ! 751: ftnlen inacclen; ! 752: char *inseq; ! 753: ftnlen inseqlen; ! 754: char *indir; ! 755: ftnlen indirlen; ! 756: char *infmt; ! 757: ftnlen infmtlen; ! 758: char *inform; ! 759: ftnint informlen; ! 760: char *inunf; ! 761: ftnlen inunflen; ! 762: ftnint *inrecl; ! 763: ftnint *innrec; ! 764: char *inblank; ! 765: ftnlen inblanklen; ! 766: } inlist; ! 767: ! 768: #define VOID void ! 769: ! 770: union Multitype { /* for multiple entry points */ ! 771: shortint h; ! 772: integer i; ! 773: real r; ! 774: doublereal d; ! 775: complex c; ! 776: doublecomplex z; ! 777: }; ! 778: ! 779: typedef union Multitype Multitype; ! 780: ! 781: typedef long Long; /* No longer used; formerly in Namelist */ ! 782: ! 783: struct Vardesc { /* for Namelist */ ! 784: char *name; ! 785: char *addr; ! 786: ftnlen *dims; ! 787: int type; ! 788: }; ! 789: typedef struct Vardesc Vardesc; ! 790: ! 791: struct Namelist { ! 792: char *name; ! 793: Vardesc **vars; ! 794: int nvars; ! 795: }; ! 796: typedef struct Namelist Namelist; ! 797: ! 798: #define abs(x) ((x) >= 0 ? (x) : -(x)) ! 799: #define dabs(x) (doublereal)abs(x) ! 800: #define min(a,b) ((a) <= (b) ? (a) : (b)) ! 801: #define max(a,b) ((a) >= (b) ? (a) : (b)) ! 802: #define dmin(a,b) (doublereal)min(a,b) ! 803: #define dmax(a,b) (doublereal)max(a,b) ! 804: ! 805: /* procedure parameter types for -A and -C++ */ ! 806: ! 807: #define F2C_proc_par_types 1 ! 808: #ifdef __cplusplus ! 809: typedef int /* Unknown procedure type */ (*U_fp)(...); ! 810: typedef shortint (*J_fp)(...); ! 811: typedef integer (*I_fp)(...); ! 812: typedef real (*R_fp)(...); ! 813: typedef doublereal (*D_fp)(...), (*E_fp)(...); ! 814: typedef /* Complex */ VOID (*C_fp)(...); ! 815: typedef /* Double Complex */ VOID (*Z_fp)(...); ! 816: typedef logical (*L_fp)(...); ! 817: typedef shortlogical (*K_fp)(...); ! 818: typedef /* Character */ VOID (*H_fp)(...); ! 819: typedef /* Subroutine */ int (*S_fp)(...); ! 820: #else ! 821: #ifndef __LCC__ ! 822: typedef int /* Unknown procedure type */ (*U_fp)(); ! 823: typedef shortint (*J_fp)(); ! 824: typedef integer (*I_fp)(); ! 825: typedef real (*R_fp)(); ! 826: typedef doublereal (*D_fp)(), (*E_fp)(); ! 827: typedef /* Complex */ VOID (*C_fp)(); ! 828: typedef /* Double Complex */ VOID (*Z_fp)(); ! 829: typedef logical (*L_fp)(); ! 830: typedef shortlogical (*K_fp)(); ! 831: typedef /* Character */ VOID (*H_fp)(); ! 832: typedef /* Subroutine */ int (*S_fp)(); ! 833: #endif ! 834: #endif ! 835: /* E_fp is for real functions when -R is not specified */ ! 836: typedef VOID C_f; /* complex function */ ! 837: typedef VOID H_f; /* character function */ ! 838: typedef VOID Z_f; /* double complex function */ ! 839: typedef doublereal E_f; /* real function with -R not specified */ ! 840: ! 841: /* undef any lower-case symbols that your C compiler predefines, e.g.: */ ! 842: ! 843: #ifndef Skip_f2c_Undefs ! 844: #undef mips ! 845: #undef sgi ! 846: #undef unix ! 847: #endif ! 848: #endif ! 849: ! 850: #ifdef __cplusplus ! 851: extern "C" { ! 852: extern void abort_(void); ! 853: extern double c_abs(complex *); ! 854: extern void c_cos(complex *, complex *); ! 855: extern void c_div(complex *, complex *, complex *); ! 856: extern void c_exp(complex *, complex *); ! 857: extern void c_log(complex *, complex *); ! 858: extern void c_sin(complex *, complex *); ! 859: extern void c_sqrt(complex *, complex *); ! 860: extern double d_abs(double *); ! 861: extern double d_acos(double *); ! 862: extern double d_asin(double *); ! 863: extern double d_atan(double *); ! 864: extern double d_atn2(double *, double *); ! 865: extern void d_cnjg(doublecomplex *, doublecomplex *); ! 866: extern double d_cos(double *); ! 867: extern double d_cosh(double *); ! 868: extern double d_dim(double *, double *); ! 869: extern double d_exp(double *); ! 870: extern double d_imag(doublecomplex *); ! 871: extern double d_int(double *); ! 872: extern double d_lg10(double *); ! 873: extern double d_log(double *); ! 874: extern double d_mod(double *, double *); ! 875: extern double d_nint(double *); ! 876: extern double d_prod(float *, float *); ! 877: extern double d_sign(double *, double *); ! 878: extern double d_sin(double *); ! 879: extern double d_sinh(double *); ! 880: extern double d_sqrt(double *); ! 881: extern double d_tan(double *); ! 882: extern double d_tanh(double *); ! 883: extern double derf_(double *); ! 884: extern double derfc_(double *); ! 885: extern void ef1asc_(long int *, long int *, long int *, long int *); ! 886: extern long int ef1cmc_(long int *, long int *, long int *, long int *); ! 887: extern double erf(double); ! 888: extern double erf_(float *); ! 889: extern double erfc(double); ! 890: extern double erfc_(float *); ! 891: extern void getarg_(long int *, char *, long int); ! 892: extern void getenv_(char *, char *, long int, long int); ! 893: extern int getpid(void); ! 894: extern short h_abs(short *); ! 895: extern short h_dim(short *, short *); ! 896: extern short h_dnnt(double *); ! 897: extern short h_indx(char *, char *, long int, long int); ! 898: extern short h_len(char *, long int); ! 899: extern short h_mod(short *, short *); ! 900: extern short h_nint(float *); ! 901: extern short h_sign(short *, short *); ! 902: extern short hl_ge(char *, char *, long int, long int); ! 903: extern short hl_gt(char *, char *, long int, long int); ! 904: extern short hl_le(char *, char *, long int, long int); ! 905: extern short hl_lt(char *, char *, long int, long int); ! 906: extern long int i_abs(long int *); ! 907: extern long int i_dim(long int *, long int *); ! 908: extern long int i_dnnt(double *); ! 909: extern long int i_indx(char *, char *, long int, long int); ! 910: extern long int i_len(char *, long int); ! 911: extern long int i_mod(long int *, long int *); ! 912: extern long int i_nint(float *); ! 913: extern long int i_sign(long int *, long int *); ! 914: extern long int iargc_(void); ! 915: extern long int l_ge(char *, char *, long int, long int); ! 916: extern long int l_gt(char *, char *, long int, long int); ! 917: extern long int l_le(char *, char *, long int, long int); ! 918: extern long int l_lt(char *, char *, long int, long int); ! 919: extern int main(int, char **); ! 920: extern int pause(void); ! 921: extern void pow_ci(complex *, complex *, long int *); ! 922: extern double pow_dd(double *, double *); ! 923: extern double pow_di(double *, long int *); ! 924: extern short pow_hh(short *, short *); ! 925: extern long int pow_ii(long int *, long int *); ! 926: extern double pow_ri(float *, long int *); ! 927: extern void pow_zi(doublecomplex *, doublecomplex *, long int *); ! 928: extern void pow_zz(doublecomplex *, doublecomplex *, doublecomplex *); ! 929: extern double r_abs(float *); ! 930: extern double r_acos(float *); ! 931: extern double r_asin(float *); ! 932: extern double r_atan(float *); ! 933: extern double r_atn2(float *, float *); ! 934: extern void r_cnjg(complex *, complex *); ! 935: extern double r_cos(float *); ! 936: extern double r_cosh(float *); ! 937: extern double r_dim(float *, float *); ! 938: extern double r_exp(float *); ! 939: extern double r_imag(complex *); ! 940: extern double r_int(float *); ! 941: extern double r_lg10(float *); ! 942: extern double r_log(float *); ! 943: extern double r_mod(float *, float *); ! 944: extern double r_nint(float *); ! 945: extern double r_sign(float *, float *); ! 946: extern double r_sin(float *); ! 947: extern double r_sinh(float *); ! 948: extern double r_sqrt(float *); ! 949: extern double r_tan(float *); ! 950: extern double r_tanh(float *); ! 951: extern void s_cat(char *, char **, long int *, long int *, long int); ! 952: extern long int s_cmp(char *, char *, long int, long int); ! 953: extern void s_copy(char *, char *, long int, long int); ! 954: extern void s_paus(char *, long int); ! 955: extern void s_rnge(char *, long int, char *, long int); ! 956: extern void s_stop(char *, long int); ! 957: extern void sig_die(char *, int); ! 958: extern long int signal_(long int *, void *); ! 959: extern int system_(char *, long int); ! 960: extern double z_abs(doublecomplex *); ! 961: extern void z_cos(doublecomplex *, doublecomplex *); ! 962: extern void z_div(doublecomplex *, doublecomplex *, doublecomplex *); ! 963: extern void z_exp(doublecomplex *, doublecomplex *); ! 964: extern void z_log(doublecomplex *, doublecomplex *); ! 965: extern void z_sin(doublecomplex *, doublecomplex *); ! 966: extern void z_sqrt(doublecomplex *, doublecomplex *); ! 967: } ! 968: #endif ! 969: ./ ADD NAME=getarg_.c TIME=708888157 ! 970: #include "f2c.h" ! 971: ! 972: /* ! 973: * subroutine getarg(k, c) ! 974: * returns the kth unix command argument in fortran character ! 975: * variable argument c ! 976: */ ! 977: ! 978: #ifdef KR_headers ! 979: VOID getarg_(n, s, ls) ftnint *n; register char *s; ftnlen ls; ! 980: #else ! 981: void getarg_(ftnint *n, register char *s, ftnlen ls) ! 982: #endif ! 983: { ! 984: extern int xargc; ! 985: extern char **xargv; ! 986: register char *t; ! 987: register int i; ! 988: ! 989: if(*n>=0 && *n<xargc) ! 990: t = xargv[*n]; ! 991: else ! 992: t = ""; ! 993: for(i = 0; i<ls && *t!='\0' ; ++i) ! 994: *s++ = *t++; ! 995: for( ; i<ls ; ++i) ! 996: *s++ = ' '; ! 997: } ! 998: ./ ADD NAME=getenv_.c TIME=708888060 ! 999: #include "f2c.h" ! 1000: ! 1001: /* ! 1002: * getenv - f77 subroutine to return environment variables ! 1003: * ! 1004: * called by: ! 1005: * call getenv (ENV_NAME, char_var) ! 1006: * where: ! 1007: * ENV_NAME is the name of an environment variable ! 1008: * char_var is a character variable which will receive ! 1009: * the current value of ENV_NAME, or all blanks ! 1010: * if ENV_NAME is not defined ! 1011: */ ! 1012: ! 1013: #ifdef KR_headers ! 1014: VOID getenv_(fname, value, flen, vlen) char *value, *fname; ftnlen vlen, flen; ! 1015: #else ! 1016: void getenv_(char *fname, char *value, ftnlen flen, ftnlen vlen) ! 1017: #endif ! 1018: { ! 1019: extern char **environ; ! 1020: register char *ep, *fp, *flast; ! 1021: register char **env = environ; ! 1022: ! 1023: flast = fname + flen; ! 1024: for(fp = fname ; fp < flast ; ++fp) ! 1025: if(*fp == ' ') ! 1026: { ! 1027: flast = fp; ! 1028: break; ! 1029: } ! 1030: ! 1031: while (ep = *env++) ! 1032: { ! 1033: for(fp = fname; fp<flast ; ) ! 1034: if(*fp++ != *ep++) ! 1035: goto endloop; ! 1036: ! 1037: if(*ep++ == '=') { /* copy right hand side */ ! 1038: while( *ep && --vlen>=0 ) ! 1039: *value++ = *ep++; ! 1040: ! 1041: goto blank; ! 1042: } ! 1043: endloop: ; ! 1044: } ! 1045: ! 1046: blank: ! 1047: while( --vlen >= 0 ) ! 1048: *value++ = ' '; ! 1049: } ! 1050: ./ ADD NAME=h_abs.c TIME=708876130 ! 1051: #include "f2c.h" ! 1052: ! 1053: #ifdef KR_headers ! 1054: shortint h_abs(x) shortint *x; ! 1055: #else ! 1056: shortint h_abs(shortint *x) ! 1057: #endif ! 1058: { ! 1059: if(*x >= 0) ! 1060: return(*x); ! 1061: return(- *x); ! 1062: } ! 1063: ./ ADD NAME=h_dim.c TIME=708876178 ! 1064: #include "f2c.h" ! 1065: ! 1066: #ifdef KR_headers ! 1067: shortint h_dim(a,b) shortint *a, *b; ! 1068: #else ! 1069: shortint h_dim(shortint *a, shortint *b) ! 1070: #endif ! 1071: { ! 1072: return( *a > *b ? *a - *b : 0); ! 1073: } ! 1074: ./ ADD NAME=h_dnnt.c TIME=708889713 ! 1075: #include "f2c.h" ! 1076: ! 1077: #ifdef KR_headers ! 1078: double floor(); ! 1079: shortint h_dnnt(x) doublereal *x; ! 1080: #else ! 1081: #undef abs ! 1082: #include "math.h" ! 1083: shortint h_dnnt(doublereal *x) ! 1084: #endif ! 1085: { ! 1086: return( (*x)>=0 ? ! 1087: floor(*x + .5) : -floor(.5 - *x) ); ! 1088: } ! 1089: ./ ADD NAME=h_indx.c TIME=708876294 ! 1090: #include "f2c.h" ! 1091: ! 1092: #ifdef KR_headers ! 1093: shortint h_indx(a, b, la, lb) char *a, *b; ftnlen la, lb; ! 1094: #else ! 1095: shortint h_indx(char *a, char *b, ftnlen la, ftnlen lb) ! 1096: #endif ! 1097: { ! 1098: int i, n; ! 1099: char *s, *t, *bend; ! 1100: ! 1101: n = la - lb + 1; ! 1102: bend = b + lb; ! 1103: ! 1104: for(i = 0 ; i < n ; ++i) ! 1105: { ! 1106: s = a + i; ! 1107: t = b; ! 1108: while(t < bend) ! 1109: if(*s++ != *t++) ! 1110: goto no; ! 1111: return(i+1); ! 1112: no: ; ! 1113: } ! 1114: return(0); ! 1115: } ! 1116: ./ ADD NAME=h_len.c TIME=708876334 ! 1117: #include "f2c.h" ! 1118: ! 1119: #ifdef KR_headers ! 1120: shortint h_len(s, n) char *s; ftnlen n; ! 1121: #else ! 1122: shortint h_len(char *s, ftnlen n) ! 1123: #endif ! 1124: { ! 1125: return(n); ! 1126: } ! 1127: ./ ADD NAME=h_mod.c TIME=708876382 ! 1128: #include "f2c.h" ! 1129: ! 1130: #ifdef KR_headers ! 1131: shortint h_mod(a,b) short *a, *b; ! 1132: #else ! 1133: shortint h_mod(short *a, short *b) ! 1134: #endif ! 1135: { ! 1136: return( *a % *b); ! 1137: } ! 1138: ./ ADD NAME=h_nint.c TIME=708889713 ! 1139: #include "f2c.h" ! 1140: ! 1141: #ifdef KR_headers ! 1142: double floor(); ! 1143: shortint h_nint(x) real *x; ! 1144: #else ! 1145: #undef abs ! 1146: #include "math.h" ! 1147: shortint h_nint(real *x) ! 1148: #endif ! 1149: { ! 1150: return( (*x)>=0 ? ! 1151: floor(*x + .5) : -floor(.5 - *x) ); ! 1152: } ! 1153: ./ ADD NAME=h_sign.c TIME=708876507 ! 1154: #include "f2c.h" ! 1155: ! 1156: #ifdef KR_headers ! 1157: shortint h_sign(a,b) shortint *a, *b; ! 1158: #else ! 1159: shortint h_sign(shortint *a, shortint *b) ! 1160: #endif ! 1161: { ! 1162: shortint x; ! 1163: x = (*a >= 0 ? *a : - *a); ! 1164: return( *b >= 0 ? x : -x); ! 1165: } ! 1166: ./ ADD NAME=hl_ge.c TIME=708875517 ! 1167: #include "f2c.h" ! 1168: ! 1169: #ifdef KR_headers ! 1170: extern integer s_cmp(); ! 1171: shortlogical hl_ge(a,b,la,lb) char *a, *b; ftnlen la, lb; ! 1172: #else ! 1173: extern integer s_cmp(char *, char *, ftnlen, ftnlen); ! 1174: shortlogical hl_ge(char *a, char *b, ftnlen la, ftnlen lb) ! 1175: #endif ! 1176: { ! 1177: return(s_cmp(a,b,la,lb) >= 0); ! 1178: } ! 1179: ./ ADD NAME=hl_gt.c TIME=708875484 ! 1180: #include "f2c.h" ! 1181: ! 1182: #ifdef KR_headers ! 1183: extern integer s_cmp(); ! 1184: shortlogical hl_gt(a,b,la,lb) char *a, *b; ftnlen la, lb; ! 1185: #else ! 1186: extern integer s_cmp(char *, char *, ftnlen, ftnlen); ! 1187: shortlogical hl_gt(char *a, char *b, ftnlen la, ftnlen lb) ! 1188: #endif ! 1189: { ! 1190: return(s_cmp(a,b,la,lb) > 0); ! 1191: } ! 1192: ./ ADD NAME=hl_le.c TIME=708875449 ! 1193: #include "f2c.h" ! 1194: ! 1195: #ifdef KR_headers ! 1196: extern integer s_cmp(); ! 1197: shortlogical hl_le(a,b,la,lb) char *a, *b; ftnlen la, lb; ! 1198: #else ! 1199: extern integer s_cmp(char *, char *, ftnlen, ftnlen); ! 1200: shortlogical hl_le(char *a, char *b, ftnlen la, ftnlen lb) ! 1201: #endif ! 1202: { ! 1203: return(s_cmp(a,b,la,lb) <= 0); ! 1204: } ! 1205: ./ ADD NAME=hl_lt.c TIME=708875277 ! 1206: #include "f2c.h" ! 1207: ! 1208: #ifdef KR_headers ! 1209: extern integer s_cmp(); ! 1210: shortlogical hl_lt(a,b,la,lb) char *a, *b; ftnlen la, lb; ! 1211: #else ! 1212: extern integer s_cmp(char *, char *, ftnlen, ftnlen); ! 1213: shortlogical hl_lt(char *a, char *b, ftnlen la, ftnlen lb) ! 1214: #endif ! 1215: { ! 1216: return(s_cmp(a,b,la,lb) < 0); ! 1217: } ! 1218: ./ ADD NAME=i_abs.c TIME=708877760 ! 1219: #include "f2c.h" ! 1220: ! 1221: #ifdef KR_headers ! 1222: integer i_abs(x) integer *x; ! 1223: #else ! 1224: integer i_abs(integer *x) ! 1225: #endif ! 1226: { ! 1227: if(*x >= 0) ! 1228: return(*x); ! 1229: return(- *x); ! 1230: } ! 1231: ./ ADD NAME=i_dim.c TIME=708877832 ! 1232: #include "f2c.h" ! 1233: ! 1234: #ifdef KR_headers ! 1235: integer i_dim(a,b) integer *a, *b; ! 1236: #else ! 1237: integer i_dim(integer *a, integer *b) ! 1238: #endif ! 1239: { ! 1240: return( *a > *b ? *a - *b : 0); ! 1241: } ! 1242: ./ ADD NAME=i_dnnt.c TIME=708889713 ! 1243: #include "f2c.h" ! 1244: ! 1245: #ifdef KR_headers ! 1246: double floor(); ! 1247: integer i_dnnt(x) doublereal *x; ! 1248: #else ! 1249: #undef abs ! 1250: #include "math.h" ! 1251: integer i_dnnt(doublereal *x) ! 1252: #endif ! 1253: { ! 1254: return( (*x)>=0 ? ! 1255: floor(*x + .5) : -floor(.5 - *x) ); ! 1256: } ! 1257: ./ ADD NAME=i_indx.c TIME=708877932 ! 1258: #include "f2c.h" ! 1259: ! 1260: #ifdef KR_headers ! 1261: integer i_indx(a, b, la, lb) char *a, *b; ftnlen la, lb; ! 1262: #else ! 1263: integer i_indx(char *a, char *b, ftnlen la, ftnlen lb) ! 1264: #endif ! 1265: { ! 1266: ftnlen i, n; ! 1267: char *s, *t, *bend; ! 1268: ! 1269: n = la - lb + 1; ! 1270: bend = b + lb; ! 1271: ! 1272: for(i = 0 ; i < n ; ++i) ! 1273: { ! 1274: s = a + i; ! 1275: t = b; ! 1276: while(t < bend) ! 1277: if(*s++ != *t++) ! 1278: goto no; ! 1279: return(i+1); ! 1280: no: ; ! 1281: } ! 1282: return(0); ! 1283: } ! 1284: ./ ADD NAME=i_len.c TIME=708877965 ! 1285: #include "f2c.h" ! 1286: ! 1287: #ifdef KR_headers ! 1288: integer i_len(s, n) char *s; ftnlen n; ! 1289: #else ! 1290: integer i_len(char *s, ftnlen n) ! 1291: #endif ! 1292: { ! 1293: return(n); ! 1294: } ! 1295: ./ ADD NAME=i_mod.c TIME=708878002 ! 1296: #include "f2c.h" ! 1297: ! 1298: #ifdef KR_headers ! 1299: integer i_mod(a,b) integer *a, *b; ! 1300: #else ! 1301: integer i_mod(integer *a, integer *b) ! 1302: #endif ! 1303: { ! 1304: return( *a % *b); ! 1305: } ! 1306: ./ ADD NAME=i_nint.c TIME=708889713 ! 1307: #include "f2c.h" ! 1308: ! 1309: #ifdef KR_headers ! 1310: double floor(); ! 1311: integer i_nint(x) real *x; ! 1312: #else ! 1313: #undef abs ! 1314: #include "math.h" ! 1315: integer i_nint(real *x) ! 1316: #endif ! 1317: { ! 1318: return( (*x)>=0 ? ! 1319: floor(*x + .5) : -floor(.5 - *x) ); ! 1320: } ! 1321: ./ ADD NAME=i_sign.c TIME=708878100 ! 1322: #include "f2c.h" ! 1323: ! 1324: #ifdef KR_headers ! 1325: integer i_sign(a,b) integer *a, *b; ! 1326: #else ! 1327: integer i_sign(integer *a, integer *b) ! 1328: #endif ! 1329: { ! 1330: integer x; ! 1331: x = (*a >= 0 ? *a : - *a); ! 1332: return( *b >= 0 ? x : -x); ! 1333: } ! 1334: ./ ADD NAME=iargc_.c TIME=708877715 ! 1335: #include "f2c.h" ! 1336: ! 1337: #ifdef KR_headers ! 1338: ftnint iargc_() ! 1339: #else ! 1340: ftnint iargc_(void) ! 1341: #endif ! 1342: { ! 1343: extern int xargc; ! 1344: return ( xargc - 1 ); ! 1345: } ! 1346: ./ ADD NAME=l_ge.c TIME=708878341 ! 1347: #include "f2c.h" ! 1348: ! 1349: #ifdef KR_headers ! 1350: extern integer s_cmp(); ! 1351: logical l_ge(a,b,la,lb) char *a, *b; ftnlen la, lb; ! 1352: #else ! 1353: extern integer s_cmp(char *, char *, ftnlen, ftnlen); ! 1354: logical l_ge(char *a, char *b, ftnlen la, ftnlen lb) ! 1355: #endif ! 1356: { ! 1357: return(s_cmp(a,b,la,lb) >= 0); ! 1358: } ! 1359: ./ ADD NAME=l_gt.c TIME=708878405 ! 1360: #include "f2c.h" ! 1361: ! 1362: #ifdef KR_headers ! 1363: extern integer s_cmp(); ! 1364: logical l_gt(a,b,la,lb) char *a, *b; ftnlen la, lb; ! 1365: #else ! 1366: extern integer s_cmp(char *, char *, ftnlen, ftnlen); ! 1367: logical l_gt(char *a, char *b, ftnlen la, ftnlen lb) ! 1368: #endif ! 1369: { ! 1370: return(s_cmp(a,b,la,lb) > 0); ! 1371: } ! 1372: ./ ADD NAME=l_le.c TIME=708878439 ! 1373: #include "f2c.h" ! 1374: ! 1375: #ifdef KR_headers ! 1376: extern integer s_cmp(); ! 1377: logical l_le(a,b,la,lb) char *a, *b; ftnlen la, lb; ! 1378: #else ! 1379: extern integer s_cmp(char *, char *, ftnlen, ftnlen); ! 1380: logical l_le(char *a, char *b, ftnlen la, ftnlen lb) ! 1381: #endif ! 1382: { ! 1383: return(s_cmp(a,b,la,lb) <= 0); ! 1384: } ! 1385: ./ ADD NAME=l_lt.c TIME=708878471 ! 1386: #include "f2c.h" ! 1387: ! 1388: #ifdef KR_headers ! 1389: extern integer s_cmp(); ! 1390: logical l_lt(a,b,la,lb) char *a, *b; ftnlen la, lb; ! 1391: #else ! 1392: extern integer s_cmp(char *, char *, ftnlen, ftnlen); ! 1393: logical l_lt(char *a, char *b, ftnlen la, ftnlen lb) ! 1394: #endif ! 1395: { ! 1396: return(s_cmp(a,b,la,lb) < 0); ! 1397: } ! 1398: ./ ADD NAME=main.c TIME=708912028 ! 1399: /* STARTUP PROCEDURE FOR UNIX FORTRAN PROGRAMS */ ! 1400: ! 1401: #include "stdio.h" ! 1402: #include "signal.h" ! 1403: ! 1404: #ifndef SIGIOT ! 1405: #define SIGIOT SIGABRT ! 1406: #endif ! 1407: ! 1408: #ifndef KR_headers ! 1409: #include "stdlib.h" ! 1410: #endif ! 1411: #ifdef __cplusplus ! 1412: extern "C" { ! 1413: #endif ! 1414: ! 1415: #ifdef NO__STDC ! 1416: #define ONEXIT onexit ! 1417: extern void f_exit(); ! 1418: #else ! 1419: #ifndef KR_headers ! 1420: extern void f_exit(void); ! 1421: #ifndef NO_ONEXIT ! 1422: #define ONEXIT atexit ! 1423: extern int atexit(void (*)(void)); ! 1424: #endif ! 1425: #else ! 1426: #ifndef NO_ONEXIT ! 1427: #define ONEXIT onexit ! 1428: extern void f_exit(); ! 1429: #endif ! 1430: #endif ! 1431: #endif ! 1432: ! 1433: #ifdef KR_headers ! 1434: extern void f_init(), sig_die(); ! 1435: extern int MAIN__(); ! 1436: #define Int /* int */ ! 1437: #else ! 1438: extern void f_init(void), sig_die(char*, int); ! 1439: extern int MAIN__(void); ! 1440: #define Int int ! 1441: #endif ! 1442: ! 1443: static void sigfdie(Int n) ! 1444: { ! 1445: sig_die("Floating Exception", 1); ! 1446: } ! 1447: ! 1448: ! 1449: static void sigidie(Int n) ! 1450: { ! 1451: sig_die("IOT Trap", 1); ! 1452: } ! 1453: ! 1454: #ifdef SIGQUIT ! 1455: static void sigqdie(Int n) ! 1456: { ! 1457: sig_die("Quit signal", 1); ! 1458: } ! 1459: #endif ! 1460: ! 1461: ! 1462: static void sigindie(Int n) ! 1463: { ! 1464: sig_die("Interrupt", 0); ! 1465: } ! 1466: ! 1467: ! 1468: ! 1469: static void sigtdie(Int n) ! 1470: { ! 1471: sig_die("Killed", 0); ! 1472: } ! 1473: ! 1474: ! 1475: int xargc; ! 1476: char **xargv; ! 1477: ! 1478: #ifdef KR_headers ! 1479: main(argc, argv) int argc; char **argv; ! 1480: #else ! 1481: main(int argc, char **argv) ! 1482: #endif ! 1483: { ! 1484: xargc = argc; ! 1485: xargv = argv; ! 1486: signal(SIGFPE, sigfdie); /* ignore underflow, enable overflow */ ! 1487: signal(SIGIOT, sigidie); ! 1488: #ifdef SIGQUIT ! 1489: if(signal(SIGQUIT,sigqdie) == SIG_IGN) ! 1490: signal(SIGQUIT, SIG_IGN); ! 1491: #endif ! 1492: if(signal(SIGINT, sigindie) == SIG_IGN) ! 1493: signal(SIGINT, SIG_IGN); ! 1494: signal(SIGTERM,sigtdie); ! 1495: ! 1496: #ifdef pdp11 ! 1497: ldfps(01200); /* detect overflow as an exception */ ! 1498: #endif ! 1499: ! 1500: f_init(); ! 1501: #ifndef NO_ONEXIT ! 1502: ONEXIT(f_exit); ! 1503: #endif ! 1504: MAIN__(); ! 1505: #ifdef NO_ONEXIT ! 1506: f_exit(); ! 1507: #endif ! 1508: exit(0); /* exit(0) rather than return(0) to bypass Cray bug */ ! 1509: } ! 1510: #ifdef __cplusplus ! 1511: } ! 1512: #endif ! 1513: ./ ADD NAME=pow_ci.c TIME=708964413 ! 1514: #include "f2c.h" ! 1515: ! 1516: #ifdef KR_headers ! 1517: VOID pow_ci(p, a, b) /* p = a**b */ ! 1518: complex *p, *a; integer *b; ! 1519: #else ! 1520: extern void pow_zi(doublecomplex*, doublecomplex*, integer*); ! 1521: void pow_ci(complex *p, complex *a, integer *b) /* p = a**b */ ! 1522: #endif ! 1523: { ! 1524: doublecomplex p1, a1; ! 1525: ! 1526: a1.r = a->r; ! 1527: a1.i = a->i; ! 1528: ! 1529: pow_zi(&p1, &a1, b); ! 1530: ! 1531: p->r = p1.r; ! 1532: p->i = p1.i; ! 1533: } ! 1534: ./ ADD NAME=pow_dd.c TIME=708889713 ! 1535: #include "f2c.h" ! 1536: ! 1537: #ifdef KR_headers ! 1538: double pow(); ! 1539: double pow_dd(ap, bp) doublereal *ap, *bp; ! 1540: #else ! 1541: #undef abs ! 1542: #include "math.h" ! 1543: double pow_dd(doublereal *ap, doublereal *bp) ! 1544: #endif ! 1545: { ! 1546: return(pow(*ap, *bp) ); ! 1547: } ! 1548: ./ ADD NAME=pow_di.c TIME=708879979 ! 1549: #include "f2c.h" ! 1550: ! 1551: #ifdef KR_headers ! 1552: double pow_di(ap, bp) doublereal *ap; integer *bp; ! 1553: #else ! 1554: double pow_di(doublereal *ap, integer *bp) ! 1555: #endif ! 1556: { ! 1557: double pow, x; ! 1558: integer n; ! 1559: ! 1560: pow = 1; ! 1561: x = *ap; ! 1562: n = *bp; ! 1563: ! 1564: if(n != 0) ! 1565: { ! 1566: if(n < 0) ! 1567: { ! 1568: if(x == 0) ! 1569: { ! 1570: return(pow); ! 1571: } ! 1572: n = -n; ! 1573: x = 1/x; ! 1574: } ! 1575: for( ; ; ) ! 1576: { ! 1577: if(n & 01) ! 1578: pow *= x; ! 1579: if(n >>= 1) ! 1580: x *= x; ! 1581: else ! 1582: break; ! 1583: } ! 1584: } ! 1585: return(pow); ! 1586: } ! 1587: ./ ADD NAME=pow_hh.c TIME=708880026 ! 1588: #include "f2c.h" ! 1589: ! 1590: #ifdef KR_headers ! 1591: shortint pow_hh(ap, bp) shortint *ap, *bp; ! 1592: #else ! 1593: shortint pow_hh(shortint *ap, shortint *bp) ! 1594: #endif ! 1595: { ! 1596: shortint pow, x, n; ! 1597: ! 1598: pow = 1; ! 1599: x = *ap; ! 1600: n = *bp; ! 1601: ! 1602: if(n < 0) ! 1603: { } ! 1604: else if(n > 0) ! 1605: for( ; ; ) ! 1606: { ! 1607: if(n & 01) ! 1608: pow *= x; ! 1609: if(n >>= 1) ! 1610: x *= x; ! 1611: else ! 1612: break; ! 1613: } ! 1614: return(pow); ! 1615: } ! 1616: ./ ADD NAME=pow_ii.c TIME=708880096 ! 1617: #include "f2c.h" ! 1618: ! 1619: #ifdef KR_headers ! 1620: integer pow_ii(ap, bp) integer *ap, *bp; ! 1621: #else ! 1622: integer pow_ii(integer *ap, integer *bp) ! 1623: #endif ! 1624: { ! 1625: integer pow, x, n; ! 1626: ! 1627: pow = 1; ! 1628: x = *ap; ! 1629: n = *bp; ! 1630: ! 1631: if(n < 0) ! 1632: { } ! 1633: else if(n > 0) ! 1634: for( ; ; ) ! 1635: { ! 1636: if(n & 01) ! 1637: pow *= x; ! 1638: if(n >>= 1) ! 1639: x *= x; ! 1640: else ! 1641: break; ! 1642: } ! 1643: return(pow); ! 1644: } ! 1645: ./ ADD NAME=pow_ri.c TIME=708880062 ! 1646: #include "f2c.h" ! 1647: ! 1648: #ifdef KR_headers ! 1649: double pow_ri(ap, bp) real *ap; integer *bp; ! 1650: #else ! 1651: double pow_ri(real *ap, integer *bp) ! 1652: #endif ! 1653: { ! 1654: double pow, x; ! 1655: integer n; ! 1656: ! 1657: pow = 1; ! 1658: x = *ap; ! 1659: n = *bp; ! 1660: ! 1661: if(n != 0) ! 1662: { ! 1663: if(n < 0) ! 1664: { ! 1665: if(x == 0) ! 1666: { ! 1667: return(pow); ! 1668: } ! 1669: n = -n; ! 1670: x = 1/x; ! 1671: } ! 1672: for( ; ; ) ! 1673: { ! 1674: if(n & 01) ! 1675: pow *= x; ! 1676: if(n >>= 1) ! 1677: x *= x; ! 1678: else ! 1679: break; ! 1680: } ! 1681: } ! 1682: return(pow); ! 1683: } ! 1684: ./ ADD NAME=pow_zi.c TIME=708879685 ! 1685: #include "f2c.h" ! 1686: ! 1687: #ifdef KR_headers ! 1688: VOID pow_zi(p, a, b) /* p = a**b */ ! 1689: doublecomplex *p, *a; integer *b; ! 1690: #else ! 1691: extern void z_div(doublecomplex*, doublecomplex*, doublecomplex*); ! 1692: void pow_zi(doublecomplex *p, doublecomplex *a, integer *b) /* p = a**b */ ! 1693: #endif ! 1694: { ! 1695: integer n; ! 1696: double t; ! 1697: doublecomplex x; ! 1698: static doublecomplex one = {1.0, 0.0}; ! 1699: ! 1700: n = *b; ! 1701: p->r = 1; ! 1702: p->i = 0; ! 1703: ! 1704: if(n == 0) ! 1705: return; ! 1706: if(n < 0) ! 1707: { ! 1708: n = -n; ! 1709: z_div(&x, &one, a); ! 1710: } ! 1711: else ! 1712: { ! 1713: x.r = a->r; ! 1714: x.i = a->i; ! 1715: } ! 1716: ! 1717: for( ; ; ) ! 1718: { ! 1719: if(n & 01) ! 1720: { ! 1721: t = p->r * x.r - p->i * x.i; ! 1722: p->i = p->r * x.i + p->i * x.r; ! 1723: p->r = t; ! 1724: } ! 1725: if(n >>= 1) ! 1726: { ! 1727: t = x.r * x.r - x.i * x.i; ! 1728: x.i = 2 * x.r * x.i; ! 1729: x.r = t; ! 1730: } ! 1731: else ! 1732: break; ! 1733: } ! 1734: } ! 1735: ./ ADD NAME=pow_zz.c TIME=708960922 ! 1736: #include "f2c.h" ! 1737: ! 1738: #ifdef KR_headers ! 1739: double log(), exp(), cos(), sin(), atan2(), Cabs(); ! 1740: VOID pow_zz(r,a,b) doublecomplex *r, *a, *b; ! 1741: #else ! 1742: #undef abs ! 1743: #include "math.h" ! 1744: extern double Cabs(double,double); ! 1745: void pow_zz(doublecomplex *r, doublecomplex *a, doublecomplex *b) ! 1746: #endif ! 1747: { ! 1748: double logr, logi, x, y; ! 1749: ! 1750: logr = log( Cabs(a->r, a->i) ); ! 1751: logi = atan2(a->i, a->r); ! 1752: ! 1753: x = exp( logr * b->r - logi * b->i ); ! 1754: y = logr * b->i + logi * b->r; ! 1755: ! 1756: r->r = x * cos(y); ! 1757: r->i = x * sin(y); ! 1758: } ! 1759: ./ ADD NAME=r_abs.c TIME=708880224 ! 1760: #include "f2c.h" ! 1761: ! 1762: #ifdef KR_headers ! 1763: double r_abs(x) real *x; ! 1764: #else ! 1765: double r_abs(real *x) ! 1766: #endif ! 1767: { ! 1768: if(*x >= 0) ! 1769: return(*x); ! 1770: return(- *x); ! 1771: } ! 1772: ./ ADD NAME=r_acos.c TIME=708889713 ! 1773: #include "f2c.h" ! 1774: ! 1775: #ifdef KR_headers ! 1776: double acos(); ! 1777: double r_acos(x) real *x; ! 1778: #else ! 1779: #undef abs ! 1780: #include "math.h" ! 1781: double r_acos(real *x) ! 1782: #endif ! 1783: { ! 1784: return( acos(*x) ); ! 1785: } ! 1786: ./ ADD NAME=r_asin.c TIME=708889713 ! 1787: #include "f2c.h" ! 1788: ! 1789: #ifdef KR_headers ! 1790: double asin(); ! 1791: double r_asin(x) real *x; ! 1792: #else ! 1793: #undef abs ! 1794: #include "math.h" ! 1795: double r_asin(real *x) ! 1796: #endif ! 1797: { ! 1798: return( asin(*x) ); ! 1799: } ! 1800: ./ ADD NAME=r_atan.c TIME=708889713 ! 1801: #include "f2c.h" ! 1802: ! 1803: #ifdef KR_headers ! 1804: double atan(); ! 1805: double r_atan(x) real *x; ! 1806: #else ! 1807: #undef abs ! 1808: #include "math.h" ! 1809: double r_atan(real *x) ! 1810: #endif ! 1811: { ! 1812: return( atan(*x) ); ! 1813: } ! 1814: ./ ADD NAME=r_atn2.c TIME=708889713 ! 1815: #include "f2c.h" ! 1816: ! 1817: #ifdef KR_headers ! 1818: double atan2(); ! 1819: double r_atn2(x,y) real *x, *y; ! 1820: #else ! 1821: #undef abs ! 1822: #include "math.h" ! 1823: double r_atn2(real *x, real *y) ! 1824: #endif ! 1825: { ! 1826: return( atan2(*x,*y) ); ! 1827: } ! 1828: ./ ADD NAME=r_cnjg.c TIME=708885238 ! 1829: #include "f2c.h" ! 1830: ! 1831: #ifdef KR_headers ! 1832: VOID r_cnjg(r, z) complex *r, *z; ! 1833: #else ! 1834: VOID r_cnjg(complex *r, complex *z) ! 1835: #endif ! 1836: { ! 1837: r->r = z->r; ! 1838: r->i = - z->i; ! 1839: } ! 1840: ./ ADD NAME=r_cos.c TIME=708889713 ! 1841: #include "f2c.h" ! 1842: ! 1843: #ifdef KR_headers ! 1844: double cos(); ! 1845: double r_cos(x) real *x; ! 1846: #else ! 1847: #undef abs ! 1848: #include "math.h" ! 1849: double r_cos(real *x) ! 1850: #endif ! 1851: { ! 1852: return( cos(*x) ); ! 1853: } ! 1854: ./ ADD NAME=r_cosh.c TIME=708889714 ! 1855: #include "f2c.h" ! 1856: ! 1857: #ifdef KR_headers ! 1858: double cosh(); ! 1859: double r_cosh(x) real *x; ! 1860: #else ! 1861: #undef abs ! 1862: #include "math.h" ! 1863: double r_cosh(real *x) ! 1864: #endif ! 1865: { ! 1866: return( cosh(*x) ); ! 1867: } ! 1868: ./ ADD NAME=r_dim.c TIME=708885323 ! 1869: #include "f2c.h" ! 1870: ! 1871: #ifdef KR_headers ! 1872: double r_dim(a,b) real *a, *b; ! 1873: #else ! 1874: double r_dim(real *a, real *b) ! 1875: #endif ! 1876: { ! 1877: return( *a > *b ? *a - *b : 0); ! 1878: } ! 1879: ./ ADD NAME=r_exp.c TIME=708889714 ! 1880: #include "f2c.h" ! 1881: ! 1882: #ifdef KR_headers ! 1883: double exp(); ! 1884: double r_exp(x) real *x; ! 1885: #else ! 1886: #undef abs ! 1887: #include "math.h" ! 1888: double r_exp(real *x) ! 1889: #endif ! 1890: { ! 1891: return( exp(*x) ); ! 1892: } ! 1893: ./ ADD NAME=r_imag.c TIME=708885387 ! 1894: #include "f2c.h" ! 1895: ! 1896: #ifdef KR_headers ! 1897: double r_imag(z) complex *z; ! 1898: #else ! 1899: double r_imag(complex *z) ! 1900: #endif ! 1901: { ! 1902: return(z->i); ! 1903: } ! 1904: ./ ADD NAME=r_int.c TIME=708889714 ! 1905: #include "f2c.h" ! 1906: ! 1907: #ifdef KR_headers ! 1908: double floor(); ! 1909: double r_int(x) real *x; ! 1910: #else ! 1911: #undef abs ! 1912: #include "math.h" ! 1913: double r_int(real *x) ! 1914: #endif ! 1915: { ! 1916: return( (*x>0) ? floor(*x) : -floor(- *x) ); ! 1917: } ! 1918: ./ ADD NAME=r_lg10.c TIME=708889714 ! 1919: #include "f2c.h" ! 1920: ! 1921: #define log10e 0.43429448190325182765 ! 1922: ! 1923: #ifdef KR_headers ! 1924: double log(); ! 1925: double r_lg10(x) real *x; ! 1926: #else ! 1927: #undef abs ! 1928: #include "math.h" ! 1929: double r_lg10(real *x) ! 1930: #endif ! 1931: { ! 1932: return( log10e * log(*x) ); ! 1933: } ! 1934: ./ ADD NAME=r_log.c TIME=708889714 ! 1935: #include "f2c.h" ! 1936: ! 1937: #ifdef KR_headers ! 1938: double log(); ! 1939: double r_log(x) real *x; ! 1940: #else ! 1941: #undef abs ! 1942: #include "math.h" ! 1943: double r_log(real *x) ! 1944: #endif ! 1945: { ! 1946: return( log(*x) ); ! 1947: } ! 1948: ./ ADD NAME=r_mod.c TIME=708889714 ! 1949: #include "f2c.h" ! 1950: ! 1951: #ifdef KR_headers ! 1952: #ifdef IEEE_drem ! 1953: double drem(); ! 1954: #else ! 1955: double floor(); ! 1956: #endif ! 1957: double r_mod(x,y) real *x, *y; ! 1958: #else ! 1959: #ifdef IEEE_drem ! 1960: double drem(double, double); ! 1961: #else ! 1962: #undef abs ! 1963: #include "math.h" ! 1964: #endif ! 1965: double r_mod(real *x, real *y) ! 1966: #endif ! 1967: { ! 1968: #ifdef IEEE_drem ! 1969: double xa, ya, z; ! 1970: if ((ya = *y) < 0.) ! 1971: ya = -ya; ! 1972: z = drem(xa = *x, ya); ! 1973: if (xa > 0) { ! 1974: if (z < 0) ! 1975: z += ya; ! 1976: } ! 1977: else if (z > 0) ! 1978: z -= ya; ! 1979: return z; ! 1980: #else ! 1981: double quotient; ! 1982: if( (quotient = (double)*x / *y) >= 0) ! 1983: quotient = floor(quotient); ! 1984: else ! 1985: quotient = -floor(-quotient); ! 1986: return(*x - (*y) * quotient ); ! 1987: #endif ! 1988: } ! 1989: ./ ADD NAME=r_nint.c TIME=708889714 ! 1990: #include "f2c.h" ! 1991: ! 1992: #ifdef KR_headers ! 1993: double floor(); ! 1994: double r_nint(x) real *x; ! 1995: #else ! 1996: #undef abs ! 1997: #include "math.h" ! 1998: double r_nint(real *x) ! 1999: #endif ! 2000: { ! 2001: return( (*x)>=0 ? ! 2002: floor(*x + .5) : -floor(.5 - *x) ); ! 2003: } ! 2004: ./ ADD NAME=r_sign.c TIME=708885772 ! 2005: #include "f2c.h" ! 2006: ! 2007: #ifdef KR_headers ! 2008: double r_sign(a,b) real *a, *b; ! 2009: #else ! 2010: double r_sign(real *a, real *b) ! 2011: #endif ! 2012: { ! 2013: double x; ! 2014: x = (*a >= 0 ? *a : - *a); ! 2015: return( *b >= 0 ? x : -x); ! 2016: } ! 2017: ./ ADD NAME=r_sin.c TIME=708889714 ! 2018: #include "f2c.h" ! 2019: ! 2020: #ifdef KR_headers ! 2021: double sin(); ! 2022: double r_sin(x) real *x; ! 2023: #else ! 2024: #undef abs ! 2025: #include "math.h" ! 2026: double r_sin(real *x) ! 2027: #endif ! 2028: { ! 2029: return( sin(*x) ); ! 2030: } ! 2031: ./ ADD NAME=r_sinh.c TIME=708889714 ! 2032: #include "f2c.h" ! 2033: ! 2034: #ifdef KR_headers ! 2035: double sinh(); ! 2036: double r_sinh(x) real *x; ! 2037: #else ! 2038: #undef abs ! 2039: #include "math.h" ! 2040: double r_sinh(real *x) ! 2041: #endif ! 2042: { ! 2043: return( sinh(*x) ); ! 2044: } ! 2045: ./ ADD NAME=r_sqrt.c TIME=708889714 ! 2046: #include "f2c.h" ! 2047: ! 2048: #ifdef KR_headers ! 2049: double sqrt(); ! 2050: double r_sqrt(x) real *x; ! 2051: #else ! 2052: #undef abs ! 2053: #include "math.h" ! 2054: double r_sqrt(real *x) ! 2055: #endif ! 2056: { ! 2057: return( sqrt(*x) ); ! 2058: } ! 2059: ./ ADD NAME=r_tan.c TIME=708890521 ! 2060: #include "f2c.h" ! 2061: ! 2062: #ifdef KR_headers ! 2063: double tan(); ! 2064: double r_tan(x) real *x; ! 2065: #else ! 2066: #undef abs ! 2067: #include "math.h" ! 2068: double r_tan(real *x) ! 2069: #endif ! 2070: { ! 2071: return( tan(*x) ); ! 2072: } ! 2073: ./ ADD NAME=r_tanh.c TIME=708889714 ! 2074: #include "f2c.h" ! 2075: ! 2076: #ifdef KR_headers ! 2077: double tanh(); ! 2078: double r_tanh(x) real *x; ! 2079: #else ! 2080: #undef abs ! 2081: #include "math.h" ! 2082: double r_tanh(real *x) ! 2083: #endif ! 2084: { ! 2085: return( tanh(*x) ); ! 2086: } ! 2087: ./ ADD NAME=s_cat.c TIME=708887176 ! 2088: #include "f2c.h" ! 2089: ! 2090: #ifdef KR_headers ! 2091: VOID s_cat(lp, rpp, rnp, np, ll) char *lp, *rpp[]; ftnlen rnp[], *np, ll; ! 2092: #else ! 2093: VOID s_cat(char *lp, char *rpp[], ftnlen rnp[], ftnlen *np, ftnlen ll) ! 2094: #endif ! 2095: { ! 2096: int i, n, nc; ! 2097: char *rp; ! 2098: ! 2099: n = *np; ! 2100: for(i = 0 ; i < n ; ++i) ! 2101: { ! 2102: nc = ll; ! 2103: if(rnp[i] < nc) ! 2104: nc = rnp[i]; ! 2105: ll -= nc; ! 2106: rp = rpp[i]; ! 2107: while(--nc >= 0) ! 2108: *lp++ = *rp++; ! 2109: } ! 2110: while(--ll >= 0) ! 2111: *lp++ = ' '; ! 2112: } ! 2113: ./ ADD NAME=s_cmp.c TIME=708887238 ! 2114: #include "f2c.h" ! 2115: ! 2116: /* compare two strings */ ! 2117: ! 2118: #ifdef KR_headers ! 2119: integer s_cmp(a, b, la, lb) register char *a, *b; ftnlen la, lb; ! 2120: #else ! 2121: integer s_cmp(register char *a, register char *b, ftnlen la, ftnlen lb) ! 2122: #endif ! 2123: { ! 2124: register char *aend, *bend; ! 2125: aend = a + la; ! 2126: bend = b + lb; ! 2127: ! 2128: if(la <= lb) ! 2129: { ! 2130: while(a < aend) ! 2131: if(*a != *b) ! 2132: return( *a - *b ); ! 2133: else ! 2134: { ++a; ++b; } ! 2135: ! 2136: while(b < bend) ! 2137: if(*b != ' ') ! 2138: return( ' ' - *b ); ! 2139: else ++b; ! 2140: } ! 2141: ! 2142: else ! 2143: { ! 2144: while(b < bend) ! 2145: if(*a == *b) ! 2146: { ++a; ++b; } ! 2147: else ! 2148: return( *a - *b ); ! 2149: while(a < aend) ! 2150: if(*a != ' ') ! 2151: return(*a - ' '); ! 2152: else ++a; ! 2153: } ! 2154: return(0); ! 2155: } ! 2156: ./ ADD NAME=s_copy.c TIME=708887356 ! 2157: #include "f2c.h" ! 2158: ! 2159: /* assign strings: a = b */ ! 2160: ! 2161: #ifdef KR_headers ! 2162: VOID s_copy(a, b, la, lb) register char *a, *b; ftnlen la, lb; ! 2163: #else ! 2164: void s_copy(register char *a, register char *b, ftnlen la, ftnlen lb) ! 2165: #endif ! 2166: { ! 2167: register char *aend, *bend; ! 2168: ! 2169: aend = a + la; ! 2170: ! 2171: if(la <= lb) ! 2172: while(a < aend) ! 2173: *a++ = *b++; ! 2174: ! 2175: else ! 2176: { ! 2177: bend = b + lb; ! 2178: while(b < bend) ! 2179: *a++ = *b++; ! 2180: while(a < aend) ! 2181: *a++ = ' '; ! 2182: } ! 2183: } ! 2184: ./ ADD NAME=s_paus.c TIME=708917853 ! 2185: #include "stdio.h" ! 2186: #include "f2c.h" ! 2187: #define PAUSESIG 15 ! 2188: ! 2189: #ifdef KR_headers ! 2190: #define Void /* void */ ! 2191: #define Int /* int */ ! 2192: #else ! 2193: #define Void void ! 2194: #define Int int ! 2195: #undef abs ! 2196: #include "stdlib.h" ! 2197: #include "signal.h" ! 2198: extern int getpid(void), isatty(int), pause(void); ! 2199: #endif ! 2200: ! 2201: #ifdef __cplusplus ! 2202: extern "C" void f_exit(void); ! 2203: #else ! 2204: extern VOID f_exit(Void); ! 2205: #endif ! 2206: ! 2207: static VOID waitpause(Int n) ! 2208: { ! 2209: return; ! 2210: } ! 2211: ! 2212: #ifdef KR_headers ! 2213: VOID s_paus(s, n) char *s; ftnlen n; ! 2214: #else ! 2215: void s_paus(char *s, ftnlen n) ! 2216: #endif ! 2217: { ! 2218: int i; ! 2219: ! 2220: fprintf(stderr, "PAUSE "); ! 2221: if(n > 0) ! 2222: for(i = 0; i<n ; ++i) ! 2223: putc(*s++, stderr); ! 2224: fprintf(stderr, " statement executed\n"); ! 2225: if( isatty(fileno(stdin)) ) ! 2226: { ! 2227: fprintf(stderr, "To resume execution, type go. Any other input will terminate job.\n"); ! 2228: fflush(stderr); ! 2229: if( getchar()!='g' || getchar()!='o' || getchar()!='\n' ) ! 2230: { ! 2231: fprintf(stderr, "STOP\n"); ! 2232: f_exit(); ! 2233: exit(0); ! 2234: } ! 2235: } ! 2236: else ! 2237: { ! 2238: fprintf(stderr, "To resume execution, execute a kill -%d %d command\n", ! 2239: PAUSESIG, getpid() ); ! 2240: signal(PAUSESIG, waitpause); ! 2241: fflush(stderr); ! 2242: pause(); ! 2243: } ! 2244: fprintf(stderr, "Execution resumes after PAUSE.\n"); ! 2245: } ! 2246: ./ ADD NAME=s_rnge.c TIME=708887851 ! 2247: #include "stdio.h" ! 2248: #include "f2c.h" ! 2249: ! 2250: /* called when a subscript is out of range */ ! 2251: ! 2252: #ifdef KR_headers ! 2253: extern VOID sig_die(); ! 2254: VOID s_rnge(varn, offset, procn, line) char *varn, *procn; ftnint offset, line; ! 2255: #else ! 2256: extern VOID sig_die(char*,int); ! 2257: void s_rnge(char *varn, ftnint offset, char *procn, ftnint line) ! 2258: #endif ! 2259: { ! 2260: register int i; ! 2261: ! 2262: fprintf(stderr, "Subscript out of range on file line %ld, procedure ", line); ! 2263: while((i = *procn) && i != '_' && i != ' ') ! 2264: putc(*procn++, stderr); ! 2265: fprintf(stderr, ".\nAttempt to access the %ld-th element of variable ", offset+1); ! 2266: while((i = *varn) && i != ' ') ! 2267: putc(*varn++, stderr); ! 2268: sig_die(".", 1); ! 2269: } ! 2270: ./ ADD NAME=s_stop.c TIME=708917916 ! 2271: #include "stdio.h" ! 2272: #include "f2c.h" ! 2273: ! 2274: #ifdef KR_headers ! 2275: extern void f_exit(); ! 2276: VOID s_stop(s, n) char *s; ftnlen n; ! 2277: #else ! 2278: #undef abs ! 2279: #include "stdlib.h" ! 2280: #ifdef __cplusplus ! 2281: extern "C" void f_exit(void); ! 2282: #else ! 2283: extern VOID f_exit(Void); ! 2284: #endif ! 2285: void s_stop(char *s, ftnlen n) ! 2286: #endif ! 2287: { ! 2288: int i; ! 2289: ! 2290: if(n > 0) ! 2291: { ! 2292: fprintf(stderr, "STOP "); ! 2293: for(i = 0; i<n ; ++i) ! 2294: putc(*s++, stderr); ! 2295: fprintf(stderr, " statement executed\n"); ! 2296: } ! 2297: f_exit(); ! 2298: exit(0); ! 2299: } ! 2300: ./ ADD NAME=sig_die.c TIME=708905928 ! 2301: #include "stdio.h" ! 2302: #include "signal.h" ! 2303: ! 2304: #ifndef SIGIOT ! 2305: #define SIGIOT SIGABRT ! 2306: #endif ! 2307: ! 2308: #ifdef __cplusplus ! 2309: extern "C" { ! 2310: #endif ! 2311: #ifdef KR_headers ! 2312: void sig_die(s, kill) register char *s; int kill; ! 2313: #else ! 2314: #include "stdlib.h" ! 2315: extern void f_exit(void); ! 2316: ! 2317: void sig_die(register char *s, int kill) ! 2318: #endif ! 2319: { ! 2320: /* print error message, then clear buffers */ ! 2321: fprintf(stderr, "%s\n", s); ! 2322: fflush(stderr); ! 2323: f_exit(); ! 2324: fflush(stderr); ! 2325: ! 2326: if(kill) ! 2327: { ! 2328: /* now get a core */ ! 2329: signal(SIGIOT, SIG_DFL); ! 2330: abort(); ! 2331: } ! 2332: else ! 2333: exit(1); ! 2334: } ! 2335: #ifdef __cplusplus ! 2336: } ! 2337: #endif ! 2338: ./ ADD NAME=signal_.c TIME=708887100 ! 2339: #include "f2c.h" ! 2340: ! 2341: #ifdef KR_headers ! 2342: typedef int (*sig_type)(); ! 2343: extern sig_type signal(); ! 2344: ! 2345: ftnint signal_(sigp, procp) ftnint *sigp, *procp; ! 2346: #else ! 2347: #include "signal.h" ! 2348: typedef void (*sig_type)(int); ! 2349: ! 2350: ftnint signal_(ftnint *sigp, void *procp) ! 2351: #endif ! 2352: { ! 2353: int sig; ! 2354: sig_type proc; ! 2355: sig = *sigp; ! 2356: proc = *(sig_type *)procp; ! 2357: ! 2358: return (ftnint)signal(sig, proc); ! 2359: } ! 2360: ./ ADD NAME=system_.c TIME=708886771 ! 2361: /* f77 interface to system routine */ ! 2362: ! 2363: #include "f2c.h" ! 2364: ! 2365: #ifdef KR_headers ! 2366: system_(s, n) register char *s; ftnlen n; ! 2367: #else ! 2368: #undef abs ! 2369: #include "stdlib.h" ! 2370: system_(register char *s, ftnlen n) ! 2371: #endif ! 2372: { ! 2373: char buff[1000]; ! 2374: register char *bp, *blast; ! 2375: ! 2376: blast = buff + (n < 1000 ? n : 1000); ! 2377: ! 2378: for(bp = buff ; bp<blast && *s!='\0' ; ) ! 2379: *bp++ = *s++; ! 2380: *bp = '\0'; ! 2381: return system(buff); ! 2382: } ! 2383: ./ ADD NAME=z_abs.c TIME=708960777 ! 2384: #include "f2c.h" ! 2385: ! 2386: #ifdef KR_headers ! 2387: double Cabs(); ! 2388: double z_abs(z) doublecomplex *z; ! 2389: #else ! 2390: double Cabs(double, double); ! 2391: double z_abs(doublecomplex *z) ! 2392: #endif ! 2393: { ! 2394: return( Cabs( z->r, z->i ) ); ! 2395: } ! 2396: ./ ADD NAME=z_cos.c TIME=708889714 ! 2397: #include "f2c.h" ! 2398: ! 2399: #ifdef KR_headers ! 2400: double sin(), cos(), sinh(), cosh(); ! 2401: VOID z_cos(r, z) doublecomplex *r, *z; ! 2402: #else ! 2403: #undef abs ! 2404: #include "math.h" ! 2405: void z_cos(doublecomplex *r, doublecomplex *z) ! 2406: #endif ! 2407: { ! 2408: r->r = cos(z->r) * cosh(z->i); ! 2409: r->i = - sin(z->r) * sinh(z->i); ! 2410: } ! 2411: ./ ADD NAME=z_div.c TIME=708886308 ! 2412: #include "f2c.h" ! 2413: ! 2414: #ifdef KR_headers ! 2415: extern void sig_die(); ! 2416: VOID z_div(c, a, b) doublecomplex *a, *b, *c; ! 2417: #else ! 2418: extern void sig_die(char*, int); ! 2419: void z_div(doublecomplex *c, doublecomplex *a, doublecomplex *b) ! 2420: #endif ! 2421: { ! 2422: double ratio, den; ! 2423: double abr, abi; ! 2424: ! 2425: if( (abr = b->r) < 0.) ! 2426: abr = - abr; ! 2427: if( (abi = b->i) < 0.) ! 2428: abi = - abi; ! 2429: if( abr <= abi ) ! 2430: { ! 2431: if(abi == 0) ! 2432: sig_die("complex division by zero", 1); ! 2433: ratio = b->r / b->i ; ! 2434: den = b->i * (1 + ratio*ratio); ! 2435: c->r = (a->r*ratio + a->i) / den; ! 2436: c->i = (a->i*ratio - a->r) / den; ! 2437: } ! 2438: ! 2439: else ! 2440: { ! 2441: ratio = b->i / b->r ; ! 2442: den = b->r * (1 + ratio*ratio); ! 2443: c->r = (a->r + a->i*ratio) / den; ! 2444: c->i = (a->i - a->r*ratio) / den; ! 2445: } ! 2446: ! 2447: } ! 2448: ./ ADD NAME=z_exp.c TIME=708889714 ! 2449: #include "f2c.h" ! 2450: ! 2451: #ifdef KR_headers ! 2452: double exp(), cos(), sin(); ! 2453: VOID z_exp(r, z) doublecomplex *r, *z; ! 2454: #else ! 2455: #undef abs ! 2456: #include "math.h" ! 2457: void z_exp(doublecomplex *r, doublecomplex *z) ! 2458: #endif ! 2459: { ! 2460: double expx; ! 2461: ! 2462: expx = exp(z->r); ! 2463: r->r = expx * cos(z->i); ! 2464: r->i = expx * sin(z->i); ! 2465: } ! 2466: ./ ADD NAME=z_log.c TIME=708960939 ! 2467: #include "f2c.h" ! 2468: ! 2469: #ifdef KR_headers ! 2470: double log(), Cabs(), atan2(); ! 2471: VOID z_log(r, z) doublecomplex *r, *z; ! 2472: #else ! 2473: #undef abs ! 2474: #include "math.h" ! 2475: extern double Cabs(double, double); ! 2476: void z_log(doublecomplex *r, doublecomplex *z) ! 2477: #endif ! 2478: { ! 2479: ! 2480: r->i = atan2(z->i, z->r); ! 2481: r->r = log( Cabs( z->r, z->i ) ); ! 2482: } ! 2483: ./ ADD NAME=z_sin.c TIME=708889714 ! 2484: #include "f2c.h" ! 2485: ! 2486: #ifdef KR_headers ! 2487: double sin(), cos(), sinh(), cosh(); ! 2488: VOID z_sin(r, z) doublecomplex *r, *z; ! 2489: #else ! 2490: #undef abs ! 2491: #include "math.h" ! 2492: void z_sin(doublecomplex *r, doublecomplex *z) ! 2493: #endif ! 2494: { ! 2495: r->r = sin(z->r) * cosh(z->i); ! 2496: r->i = cos(z->r) * sinh(z->i); ! 2497: } ! 2498: ./ ADD NAME=z_sqrt.c TIME=708960856 ! 2499: #include "f2c.h" ! 2500: ! 2501: #ifdef KR_headers ! 2502: double sqrt(), Cabs(); ! 2503: VOID z_sqrt(r, z) doublecomplex *r, *z; ! 2504: #else ! 2505: #undef abs ! 2506: #include "math.h" ! 2507: extern double Cabs(double, double); ! 2508: void z_sqrt(doublecomplex *r, doublecomplex *z) ! 2509: #endif ! 2510: { ! 2511: double mag; ! 2512: ! 2513: if( (mag = Cabs(z->r, z->i)) == 0.) ! 2514: r->r = r->i = 0.; ! 2515: else if(z->r > 0) ! 2516: { ! 2517: r->r = sqrt(0.5 * (mag + z->r) ); ! 2518: r->i = z->i / r->r / 2; ! 2519: } ! 2520: else ! 2521: { ! 2522: r->i = sqrt(0.5 * (mag - z->r) ); ! 2523: if(z->i < 0) ! 2524: r->i = - r->i; ! 2525: r->r = z->i / r->i / 2; ! 2526: } ! 2527: } ! 2528: ./ ENDUP
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.