![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to libF77.st0 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 libF77.st0 CVS log | Up to [Research Unix] / researchv10no / cmd / f2c |
1.1 ! root 1: ./ ADD NAME=libF77/README TIME=627343162 ! 2: If your system lacks onexit() and you are not using an ANSI C ! 3: compiler, then you should compile main.c with NO_ONEXIT defined. ! 4: See the comments about onexit in the makefile. ! 5: ! 6: If your system lacks a _cleanup routine (which is called just ! 7: before abort(), e.g. to flush buffers), just add a dummy, i.e., ! 8: _cleanup() {} ! 9: to libF77. ! 10: ./ ADD NAME=libF77/makefile TIME=627748011 ! 11: .SUFFIXES: .c .o ! 12: # compile, then strip unnecessary symbols ! 13: .c.o: ! 14: cc -O -c $*.c ! 15: ld -r -x $*.o ! 16: mv a.out $*.o ! 17: ! 18: MISC = Version.o main.o s_rnge.o abort_.o getarg_.o iargc_.o getenv_.o\ ! 19: signal_.o s_stop.o s_paus.o system_.o cabs.o\ ! 20: derf_.o derfc_.o erf_.o erfc_.o ! 21: POW = pow_ci.o pow_dd.o pow_di.o pow_hh.o pow_ii.o pow_ri.o pow_zi.o pow_zz.o ! 22: CX = c_abs.o c_cos.o c_div.o c_exp.o c_log.o c_sin.o c_sqrt.o ! 23: DCX = z_abs.o z_cos.o z_div.o z_exp.o z_log.o z_sin.o z_sqrt.o ! 24: REAL = r_abs.o r_acos.o r_asin.o r_atan.o r_atn2.o r_cnjg.o r_cos.o\ ! 25: r_cosh.o r_dim.o r_exp.o r_imag.o r_int.o\ ! 26: r_lg10.o r_log.o r_mod.o r_nint.o r_sign.o\ ! 27: r_sin.o r_sinh.o r_sqrt.o r_tan.o r_tanh.o ! 28: DBL = d_abs.o d_acos.o d_asin.o d_atan.o d_atn2.o\ ! 29: d_cnjg.o d_cos.o d_cosh.o d_dim.o d_exp.o\ ! 30: d_imag.o d_int.o d_lg10.o d_log.o d_mod.o\ ! 31: d_nint.o d_prod.o d_sign.o d_sin.o d_sinh.o\ ! 32: d_sqrt.o d_tan.o d_tanh.o ! 33: INT = i_abs.o i_dim.o i_dnnt.o i_indx.o i_len.o i_mod.o i_nint.o i_sign.o ! 34: HALF = h_abs.o h_dim.o h_dnnt.o h_indx.o h_len.o h_mod.o h_nint.o h_sign.o ! 35: CMP = l_ge.o l_gt.o l_le.o l_lt.o hl_ge.o hl_gt.o hl_le.o hl_lt.o ! 36: EFL = ef1asc_.o ef1cmc_.o ! 37: CHAR = s_cat.o s_cmp.o s_copy.o ! 38: ! 39: libF77.a : $(MISC) $(POW) $(CX) $(DCX) $(REAL) $(DBL) $(INT) \ ! 40: $(HALF) $(CMP) $(EFL) $(CHAR) ! 41: ar r libF77.a $? ! 42: ranlib libF77.a ! 43: ! 44: Version.o: Version.c ! 45: cc -c Version.c ! 46: ! 47: # If your system lacks onexit() and you are not using an ! 48: # ANSI C compiler, then you should uncomment the following ! 49: # two lines (for compiling main.o): ! 50: #main.o: main.c ! 51: # cc -c -DNO_ONEXIT main.c ! 52: # On at least some Sun systems, it is more appropriate to ! 53: # uncomment the following two lines: ! 54: #main.o: main.c ! 55: # cc -c -Donexit=on_exit main.c ! 56: ! 57: install: libF77.a ! 58: mv libF77.a /usr/lib ! 59: ! 60: clean: ! 61: rm -f libF77.a *.o ! 62: ./ ADD NAME=libF77/Version.c TIME=628430639 ! 63: static char junk[] = "\n@(#)LIBF77 VERSION 2.01 30 Nov. 1989\n"; ! 64: ! 65: /* ! 66: 2.00 11 June 1980. File version.c added to library. ! 67: 2.01 31 May 1988. s_paus() flushes stderr; names of hl_* fixed ! 68: [ d]erf[c ] added ! 69: 8 Aug. 1989: #ifdefs for f2c -i2 added to s_cat.c ! 70: 29 Nov. 1989: s_cmp returns long (for f2c). ! 71: 30 Nov. 1989: arg types from argtypes.h ! 72: */ ! 73: ./ ADD NAME=libF77/abort_.c TIME=628474861 ! 74: #include "stdio.h" ! 75: #include "f2c.h" ! 76: ! 77: extern VOID abort(); ! 78: ! 79: VOID abort_() ! 80: { ! 81: fprintf(stderr, "Fortran abort routine called\n"); ! 82: _cleanup(); ! 83: abort(); ! 84: } ! 85: ./ ADD NAME=libF77/c_abs.c TIME=628437500 ! 86: #include "f2c.h" ! 87: ! 88: double c_abs(z) ! 89: complex *z; ! 90: { ! 91: double cabs(); ! 92: ! 93: return( cabs( z->r, z->i ) ); ! 94: } ! 95: ./ ADD NAME=libF77/c_cos.c TIME=628437500 ! 96: #include "f2c.h" ! 97: ! 98: VOID c_cos(r, z) ! 99: complex *r, *z; ! 100: { ! 101: double sin(), cos(), sinh(), cosh(); ! 102: ! 103: r->r = cos(z->r) * cosh(z->i); ! 104: r->i = - sin(z->r) * sinh(z->i); ! 105: } ! 106: ./ ADD NAME=libF77/c_div.c TIME=628437671 ! 107: #include "f2c.h" ! 108: ! 109: VOID c_div(c, a, b) ! 110: complex *a, *b, *c; ! 111: { ! 112: double ratio, den; ! 113: double abr, abi; ! 114: ! 115: if( (abr = b->r) < 0.) ! 116: abr = - abr; ! 117: if( (abi = b->i) < 0.) ! 118: abi = - abi; ! 119: if( abr <= abi ) ! 120: { ! 121: if(abi == 0) ! 122: abort(); /* fatal("complex division by zero"); */ ! 123: ratio = b->r / b->i ; ! 124: den = b->i * (1 + ratio*ratio); ! 125: c->r = (a->r*ratio + a->i) / den; ! 126: c->i = (a->i*ratio - a->r) / den; ! 127: } ! 128: ! 129: else ! 130: { ! 131: ratio = b->i / b->r ; ! 132: den = b->r * (1 + ratio*ratio); ! 133: c->r = (a->r + a->i*ratio) / den; ! 134: c->i = (a->i - a->r*ratio) / den; ! 135: } ! 136: } ! 137: ./ ADD NAME=libF77/c_exp.c TIME=628437500 ! 138: #include "f2c.h" ! 139: ! 140: VOID c_exp(r, z) ! 141: complex *r, *z; ! 142: { ! 143: double expx; ! 144: double exp(), cos(), sin(); ! 145: ! 146: expx = exp(z->r); ! 147: r->r = expx * cos(z->i); ! 148: r->i = expx * sin(z->i); ! 149: } ! 150: ./ ADD NAME=libF77/c_log.c TIME=628437500 ! 151: #include "f2c.h" ! 152: ! 153: VOID c_log(r, z) ! 154: complex *r, *z; ! 155: { ! 156: double log(), cabs(), atan2(); ! 157: ! 158: r->i = atan2(z->i, z->r); ! 159: r->r = log( cabs(z->r, z->i) ); ! 160: } ! 161: ./ ADD NAME=libF77/c_sin.c TIME=628437501 ! 162: #include "f2c.h" ! 163: ! 164: VOID c_sin(r, z) ! 165: complex *r, *z; ! 166: { ! 167: double sin(), cos(), sinh(), cosh(); ! 168: ! 169: r->r = sin(z->r) * cosh(z->i); ! 170: r->i = cos(z->r) * sinh(z->i); ! 171: } ! 172: ./ ADD NAME=libF77/c_sqrt.c TIME=628437501 ! 173: #include "f2c.h" ! 174: ! 175: VOID c_sqrt(r, z) ! 176: complex *r, *z; ! 177: { ! 178: double mag, sqrt(), cabs(); ! 179: ! 180: if( (mag = cabs(z->r, z->i)) == 0.) ! 181: r->r = r->i = 0.; ! 182: else if(z->r > 0) ! 183: { ! 184: r->r = sqrt(0.5 * (mag + z->r) ); ! 185: r->i = z->i / r->r / 2; ! 186: } ! 187: else ! 188: { ! 189: r->i = sqrt(0.5 * (mag - z->r) ); ! 190: if(z->i < 0) ! 191: r->i = - r->i; ! 192: r->r = z->i / r->i /2; ! 193: } ! 194: } ! 195: ./ ADD NAME=libF77/cabs.c TIME=379733534 ! 196: double cabs(real, imag) ! 197: double real, imag; ! 198: { ! 199: double temp, sqrt(); ! 200: ! 201: if(real < 0) ! 202: real = -real; ! 203: if(imag < 0) ! 204: imag = -imag; ! 205: if(imag > real){ ! 206: temp = real; ! 207: real = imag; ! 208: imag = temp; ! 209: } ! 210: if((real+imag) == real) ! 211: return(real); ! 212: ! 213: temp = imag/real; ! 214: temp = real*sqrt(1.0 + temp*temp); /*overflow!!*/ ! 215: return(temp); ! 216: } ! 217: ./ ADD NAME=libF77/argtypes.h TIME=628436547 ! 218: typedef long integer; ! 219: typedef short shortint; ! 220: typedef double doublereal; ! 221: typedef float real; ! 222: typedef struct { float real, imag; } complex; ! 223: typedef struct { double dreal, dimag; } dcomplex; ! 224: typedef void VOID; ! 225: /* VOID can be int on systems that do not recognize void */ ! 226: ./ ADD NAME=libF77/d_abs.c TIME=628437501 ! 227: #include "f2c.h" ! 228: ! 229: double d_abs(x) ! 230: doublereal *x; ! 231: { ! 232: if(*x >= 0) ! 233: return(*x); ! 234: return(- *x); ! 235: } ! 236: ./ ADD NAME=libF77/d_acos.c TIME=628437502 ! 237: #include "f2c.h" ! 238: ! 239: double d_acos(x) ! 240: doublereal *x; ! 241: { ! 242: double acos(); ! 243: return( acos(*x) ); ! 244: } ! 245: ./ ADD NAME=libF77/d_asin.c TIME=628437502 ! 246: #include "f2c.h" ! 247: ! 248: double d_asin(x) ! 249: doublereal *x; ! 250: { ! 251: double asin(); ! 252: return( asin(*x) ); ! 253: } ! 254: ./ ADD NAME=libF77/d_atan.c TIME=628437502 ! 255: #include "f2c.h" ! 256: ! 257: double d_atan(x) ! 258: doublereal *x; ! 259: { ! 260: double atan(); ! 261: return( atan(*x) ); ! 262: } ! 263: ./ ADD NAME=libF77/d_atn2.c TIME=628437502 ! 264: #include "f2c.h" ! 265: ! 266: double d_atn2(x,y) ! 267: doublereal *x, *y; ! 268: { ! 269: double atan2(); ! 270: return( atan2(*x,*y) ); ! 271: } ! 272: ./ ADD NAME=libF77/d_cnjg.c TIME=628437502 ! 273: #include "f2c.h" ! 274: ! 275: d_cnjg(r, z) ! 276: doublecomplex *r, *z; ! 277: { ! 278: r->r = z->r; ! 279: r->i = - z->i; ! 280: } ! 281: ./ ADD NAME=libF77/d_cos.c TIME=628437502 ! 282: #include "f2c.h" ! 283: ! 284: double d_cos(x) ! 285: doublereal *x; ! 286: { ! 287: double cos(); ! 288: return( cos(*x) ); ! 289: } ! 290: ./ ADD NAME=libF77/d_cosh.c TIME=628437503 ! 291: #include "f2c.h" ! 292: ! 293: double d_cosh(x) ! 294: doublereal *x; ! 295: { ! 296: double cosh(); ! 297: return( cosh(*x) ); ! 298: } ! 299: ./ ADD NAME=libF77/d_dim.c TIME=628437503 ! 300: #include "f2c.h" ! 301: ! 302: double d_dim(a,b) ! 303: doublereal *a, *b; ! 304: { ! 305: return( *a > *b ? *a - *b : 0); ! 306: } ! 307: ./ ADD NAME=libF77/d_exp.c TIME=628437503 ! 308: #include "f2c.h" ! 309: ! 310: double d_exp(x) ! 311: doublereal *x; ! 312: { ! 313: double exp(); ! 314: return( exp(*x) ); ! 315: } ! 316: ./ ADD NAME=libF77/d_imag.c TIME=628437503 ! 317: #include "f2c.h" ! 318: ! 319: double d_imag(z) ! 320: doublecomplex *z; ! 321: { ! 322: return(z->i); ! 323: } ! 324: ./ ADD NAME=libF77/d_int.c TIME=628437503 ! 325: #include "f2c.h" ! 326: ! 327: double d_int(x) ! 328: doublereal *x; ! 329: { ! 330: double floor(); ! 331: ! 332: return( (*x>0) ? floor(*x) : -floor(- *x) ); ! 333: } ! 334: ./ ADD NAME=libF77/d_lg10.c TIME=628437503 ! 335: #include "f2c.h" ! 336: ! 337: #define log10e 0.43429448190325182765 ! 338: ! 339: double d_lg10(x) ! 340: doublereal *x; ! 341: { ! 342: double log(); ! 343: ! 344: return( log10e * log(*x) ); ! 345: } ! 346: ./ ADD NAME=libF77/d_log.c TIME=628437503 ! 347: #include "f2c.h" ! 348: ! 349: double d_log(x) ! 350: doublereal *x; ! 351: { ! 352: double log(); ! 353: return( log(*x) ); ! 354: } ! 355: ./ ADD NAME=libF77/d_mod.c TIME=628437503 ! 356: #include "f2c.h" ! 357: ! 358: double d_mod(x,y) ! 359: doublereal *x, *y; ! 360: { ! 361: double floor(), quotient; ! 362: if( (quotient = *x / *y) >= 0) ! 363: quotient = floor(quotient); ! 364: else ! 365: quotient = -floor(-quotient); ! 366: return(*x - (*y) * quotient ); ! 367: } ! 368: ./ ADD NAME=libF77/d_nint.c TIME=628437504 ! 369: #include "f2c.h" ! 370: ! 371: double d_nint(x) ! 372: doublereal *x; ! 373: { ! 374: double floor(); ! 375: ! 376: return( (*x)>=0 ? ! 377: floor(*x + .5) : -floor(.5 - *x) ); ! 378: } ! 379: ./ ADD NAME=libF77/d_prod.c TIME=628437504 ! 380: #include "f2c.h" ! 381: ! 382: double d_prod(x,y) ! 383: real *x, *y; ! 384: { ! 385: return( (*x) * (*y) ); ! 386: } ! 387: ./ ADD NAME=libF77/d_sign.c TIME=628437504 ! 388: #include "f2c.h" ! 389: ! 390: double d_sign(a,b) ! 391: doublereal *a, *b; ! 392: { ! 393: double x; ! 394: x = (*a >= 0 ? *a : - *a); ! 395: return( *b >= 0 ? x : -x); ! 396: } ! 397: ./ ADD NAME=libF77/d_sin.c TIME=628437504 ! 398: #include "f2c.h" ! 399: ! 400: double d_sin(x) ! 401: doublereal *x; ! 402: { ! 403: double sin(); ! 404: return( sin(*x) ); ! 405: } ! 406: ./ ADD NAME=libF77/d_sinh.c TIME=628437504 ! 407: #include "f2c.h" ! 408: ! 409: double d_sinh(x) ! 410: doublereal *x; ! 411: { ! 412: double sinh(); ! 413: return( sinh(*x) ); ! 414: } ! 415: ./ ADD NAME=libF77/d_sqrt.c TIME=628437504 ! 416: #include "f2c.h" ! 417: ! 418: double d_sqrt(x) ! 419: doublereal *x; ! 420: { ! 421: double sqrt(); ! 422: return( sqrt(*x) ); ! 423: } ! 424: ./ ADD NAME=libF77/d_tan.c TIME=628437504 ! 425: #include "f2c.h" ! 426: ! 427: double d_tan(x) ! 428: doublereal *x; ! 429: { ! 430: double tan(); ! 431: return( tan(*x) ); ! 432: } ! 433: ./ ADD NAME=libF77/d_tanh.c TIME=628437504 ! 434: #include "f2c.h" ! 435: ! 436: double d_tanh(x) ! 437: doublereal *x; ! 438: { ! 439: double tanh(); ! 440: return( tanh(*x) ); ! 441: } ! 442: ./ ADD NAME=libF77/derf_.c TIME=628437505 ! 443: #include "f2c.h" ! 444: ! 445: double derf_(x) ! 446: doublereal *x; ! 447: { ! 448: double erf(); ! 449: ! 450: return( erf(*x) ); ! 451: } ! 452: ./ ADD NAME=libF77/derfc_.c TIME=628437505 ! 453: #include "f2c.h" ! 454: ! 455: double derfc_(x) ! 456: doublereal *x; ! 457: { ! 458: double erfc(); ! 459: ! 460: return( erfc(*x) ); ! 461: } ! 462: ./ ADD NAME=libF77/ef1asc_.c TIME=628437505 ! 463: /* EFL support routine to copy string b to string a */ ! 464: ! 465: #include "f2c.h" ! 466: ! 467: extern VOID s_copy(); ! 468: ! 469: #define M ( (long) (sizeof(long) - 1) ) ! 470: #define EVEN(x) ( ( (x)+ M) & (~M) ) ! 471: ! 472: VOID ef1asc_(a, la, b, lb) ! 473: int *a, *b; ! 474: long int *la, *lb; ! 475: { ! 476: s_copy( (char *)a, (char *)b, EVEN(*la), *lb ); ! 477: } ! 478: ./ ADD NAME=libF77/ef1cmc_.c TIME=628437505 ! 479: /* EFL support routine to compare two character strings */ ! 480: ! 481: #include "f2c.h" ! 482: ! 483: extern integer s_cmp(); ! 484: ! 485: integer ef1cmc_(a, la, b, lb) ! 486: integer *a, *b; ! 487: integer *la, *lb; ! 488: { ! 489: return( s_cmp( (char *)a, (char *)b, *la, *lb) ); ! 490: } ! 491: ./ ADD NAME=libF77/erf_.c TIME=628437505 ! 492: #include "f2c.h" ! 493: ! 494: double erf_(x) ! 495: real *x; ! 496: { ! 497: double erf(); ! 498: ! 499: return( erf(*x) ); ! 500: } ! 501: ./ ADD NAME=libF77/erfc_.c TIME=628437505 ! 502: #include "f2c.h" ! 503: ! 504: double erfc_(x) ! 505: real *x; ! 506: { ! 507: double erfc(); ! 508: ! 509: return( erfc(*x) ); ! 510: } ! 511: ./ ADD NAME=libF77/getarg_.c TIME=628437505 ! 512: #include "f2c.h" ! 513: ! 514: /* ! 515: * subroutine getarg(k, c) ! 516: * returns the kth unix command argument in fortran character ! 517: * variable argument c ! 518: */ ! 519: ! 520: VOID getarg_(n, s, ls) ! 521: long int *n; ! 522: register char *s; ! 523: long int ls; ! 524: { ! 525: extern int xargc; ! 526: extern char **xargv; ! 527: register char *t; ! 528: register int i; ! 529: ! 530: if(*n>=0 && *n<xargc) ! 531: t = xargv[*n]; ! 532: else ! 533: t = ""; ! 534: for(i = 0; i<ls && *t!='\0' ; ++i) ! 535: *s++ = *t++; ! 536: for( ; i<ls ; ++i) ! 537: *s++ = ' '; ! 538: } ! 539: ./ ADD NAME=libF77/getenv_.c TIME=628437505 ! 540: #include "f2c.h" ! 541: ! 542: /* ! 543: * getenv - f77 subroutine to return environment variables ! 544: * ! 545: * called by: ! 546: * call getenv (ENV_NAME, char_var) ! 547: * where: ! 548: * ENV_NAME is the name of an environment variable ! 549: * char_var is a character variable which will receive ! 550: * the current value of ENV_NAME, or all blanks ! 551: * if ENV_NAME is not defined ! 552: */ ! 553: ! 554: VOID getenv_(fname, value, flen, vlen) ! 555: char *value, *fname; ! 556: long int vlen, flen; ! 557: { ! 558: extern char **environ; ! 559: register char *ep, *fp, *flast; ! 560: register char **env = environ; ! 561: ! 562: flast = fname + flen; ! 563: for(fp = fname ; fp < flast ; ++fp) ! 564: if(*fp == ' ') ! 565: { ! 566: flast = fp; ! 567: break; ! 568: } ! 569: ! 570: while (ep = *env++) ! 571: { ! 572: for(fp = fname; fp<flast ; ) ! 573: if(*fp++ != *ep++) ! 574: goto endloop; ! 575: ! 576: if(*ep++ == '=') /* copy right hand side */ ! 577: while( *ep && --vlen>=0 ) ! 578: *value++ = *ep++; ! 579: ! 580: goto blank; ! 581: ! 582: endloop: ; ! 583: } ! 584: ! 585: blank: ! 586: while( --vlen >= 0 ) ! 587: *value++ = ' '; ! 588: } ! 589: ./ ADD NAME=libF77/h_abs.c TIME=628437506 ! 590: #include "f2c.h" ! 591: ! 592: extern integer s_cmp(); ! 593: ! 594: shortint h_abs(x) ! 595: shortint *x; ! 596: { ! 597: if(*x >= 0) ! 598: return(*x); ! 599: return(- *x); ! 600: } ! 601: ./ ADD NAME=libF77/h_dim.c TIME=628437506 ! 602: #include "f2c.h" ! 603: ! 604: extern integer s_cmp(); ! 605: ! 606: shortint h_dim(a,b) ! 607: shortint *a, *b; ! 608: { ! 609: return( *a > *b ? *a - *b : 0); ! 610: } ! 611: ./ ADD NAME=libF77/h_dnnt.c TIME=628437506 ! 612: #include "f2c.h" ! 613: ! 614: extern integer s_cmp(); ! 615: ! 616: shortint h_dnnt(x) ! 617: doublereal *x; ! 618: { ! 619: double floor(); ! 620: ! 621: return( (*x)>=0 ? ! 622: floor(*x + .5) : -floor(.5 - *x) ); ! 623: } ! 624: ./ ADD NAME=libF77/h_indx.c TIME=628437506 ! 625: #include "f2c.h" ! 626: ! 627: extern integer s_cmp(); ! 628: ! 629: shortint h_indx(a, b, la, lb) ! 630: char *a, *b; ! 631: long int la, lb; ! 632: { ! 633: int i, n; ! 634: char *s, *t, *bend; ! 635: ! 636: n = la - lb + 1; ! 637: bend = b + lb; ! 638: ! 639: for(i = 0 ; i < n ; ++i) ! 640: { ! 641: s = a + i; ! 642: t = b; ! 643: while(t < bend) ! 644: if(*s++ != *t++) ! 645: goto no; ! 646: return(i+1); ! 647: no: ; ! 648: } ! 649: return(0); ! 650: } ! 651: ./ ADD NAME=libF77/h_len.c TIME=628437506 ! 652: #include "f2c.h" ! 653: ! 654: extern integer s_cmp(); ! 655: ! 656: shortint h_len(s, n) ! 657: char *s; ! 658: long int n; ! 659: { ! 660: return(n); ! 661: } ! 662: ./ ADD NAME=libF77/h_mod.c TIME=628437506 ! 663: #include "f2c.h" ! 664: ! 665: extern integer s_cmp(); ! 666: ! 667: shortint h_mod(a,b) ! 668: short *a, *b; ! 669: { ! 670: return( *a % *b); ! 671: } ! 672: ./ ADD NAME=libF77/h_nint.c TIME=628437506 ! 673: #include "f2c.h" ! 674: ! 675: extern integer s_cmp(); ! 676: ! 677: shortint h_nint(x) ! 678: real *x; ! 679: { ! 680: double floor(); ! 681: ! 682: return( (*x)>=0 ? ! 683: floor(*x + .5) : -floor(.5 - *x) ); ! 684: } ! 685: ./ ADD NAME=libF77/h_sign.c TIME=628437507 ! 686: #include "f2c.h" ! 687: ! 688: extern integer s_cmp(); ! 689: ! 690: shortint h_sign(a,b) ! 691: shortint *a, *b; ! 692: { ! 693: shortint x; ! 694: x = (*a >= 0 ? *a : - *a); ! 695: return( *b >= 0 ? x : -x); ! 696: } ! 697: ./ ADD NAME=libF77/hl_ge.c TIME=628437507 ! 698: #include "f2c.h" ! 699: ! 700: extern integer s_cmp(); ! 701: ! 702: shortint hl_ge(a,b,la,lb) ! 703: char *a, *b; ! 704: long int la, lb; ! 705: { ! 706: return(s_cmp(a,b,la,lb) >= 0); ! 707: } ! 708: ./ ADD NAME=libF77/hl_gt.c TIME=628437507 ! 709: #include "f2c.h" ! 710: ! 711: extern integer s_cmp(); ! 712: ! 713: shortint hl_gt(a,b,la,lb) ! 714: char *a, *b; ! 715: long int la, lb; ! 716: { ! 717: return(s_cmp(a,b,la,lb) > 0); ! 718: } ! 719: ./ ADD NAME=libF77/hl_le.c TIME=628437507 ! 720: #include "f2c.h" ! 721: ! 722: extern integer s_cmp(); ! 723: ! 724: shortint hl_le(a,b,la,lb) ! 725: char *a, *b; ! 726: long int la, lb; ! 727: { ! 728: return(s_cmp(a,b,la,lb) <= 0); ! 729: } ! 730: ./ ADD NAME=libF77/hl_lt.c TIME=628437507 ! 731: #include "f2c.h" ! 732: ! 733: extern integer s_cmp(); ! 734: ! 735: shortint hl_lt(a,b,la,lb) ! 736: char *a, *b; ! 737: long int la, lb; ! 738: { ! 739: return(s_cmp(a,b,la,lb) < 0); ! 740: } ! 741: ./ ADD NAME=libF77/i_abs.c TIME=628437507 ! 742: #include "f2c.h" ! 743: ! 744: integer i_abs(x) ! 745: integer *x; ! 746: { ! 747: if(*x >= 0) ! 748: return(*x); ! 749: return(- *x); ! 750: } ! 751: ./ ADD NAME=libF77/i_dim.c TIME=628437507 ! 752: #include "f2c.h" ! 753: ! 754: integer i_dim(a,b) ! 755: integer *a, *b; ! 756: { ! 757: return( *a > *b ? *a - *b : 0); ! 758: } ! 759: ./ ADD NAME=libF77/i_dnnt.c TIME=628437507 ! 760: #include "f2c.h" ! 761: ! 762: integer i_dnnt(x) ! 763: doublereal *x; ! 764: { ! 765: double floor(); ! 766: ! 767: return( (*x)>=0 ? ! 768: floor(*x + .5) : -floor(.5 - *x) ); ! 769: } ! 770: ./ ADD NAME=libF77/i_indx.c TIME=628437507 ! 771: #include "f2c.h" ! 772: ! 773: integer i_indx(a, b, la, lb) ! 774: char *a, *b; ! 775: long int la, lb; ! 776: { ! 777: long int i, n; ! 778: char *s, *t, *bend; ! 779: ! 780: n = la - lb + 1; ! 781: bend = b + lb; ! 782: ! 783: for(i = 0 ; i < n ; ++i) ! 784: { ! 785: s = a + i; ! 786: t = b; ! 787: while(t < bend) ! 788: if(*s++ != *t++) ! 789: goto no; ! 790: return(i+1); ! 791: no: ; ! 792: } ! 793: return(0); ! 794: } ! 795: ./ ADD NAME=libF77/i_len.c TIME=628437508 ! 796: #include "f2c.h" ! 797: ! 798: integer i_len(s, n) ! 799: char *s; ! 800: long int n; ! 801: { ! 802: return(n); ! 803: } ! 804: ./ ADD NAME=libF77/i_mod.c TIME=628437508 ! 805: #include "f2c.h" ! 806: ! 807: integer i_mod(a,b) ! 808: integer *a, *b; ! 809: { ! 810: return( *a % *b); ! 811: } ! 812: ./ ADD NAME=libF77/i_nint.c TIME=628437508 ! 813: #include "f2c.h" ! 814: ! 815: integer i_nint(x) ! 816: real *x; ! 817: { ! 818: double floor(); ! 819: ! 820: return( (*x)>=0 ? ! 821: floor(*x + .5) : -floor(.5 - *x) ); ! 822: } ! 823: ./ ADD NAME=libF77/i_sign.c TIME=628437508 ! 824: #include "f2c.h" ! 825: ! 826: integer i_sign(a,b) ! 827: integer *a, *b; ! 828: { ! 829: integer x; ! 830: x = (*a >= 0 ? *a : - *a); ! 831: return( *b >= 0 ? x : -x); ! 832: } ! 833: ./ ADD NAME=libF77/iargc_.c TIME=628437508 ! 834: #include "f2c.h" ! 835: ! 836: integer iargc_() ! 837: { ! 838: extern int xargc; ! 839: return ( xargc - 1 ); ! 840: } ! 841: ./ ADD NAME=libF77/l_ge.c TIME=628437508 ! 842: #include "f2c.h" ! 843: ! 844: extern integer s_cmp(); ! 845: ! 846: integer l_ge(a,b,la,lb) ! 847: char *a, *b; ! 848: long int la, lb; ! 849: { ! 850: return(s_cmp(a,b,la,lb) >= 0); ! 851: } ! 852: ./ ADD NAME=libF77/l_gt.c TIME=628437508 ! 853: #include "f2c.h" ! 854: ! 855: extern integer s_cmp(); ! 856: ! 857: integer l_gt(a,b,la,lb) ! 858: char *a, *b; ! 859: long int la, lb; ! 860: { ! 861: return(s_cmp(a,b,la,lb) > 0); ! 862: } ! 863: ./ ADD NAME=libF77/l_le.c TIME=628437508 ! 864: #include "f2c.h" ! 865: ! 866: extern integer s_cmp(); ! 867: ! 868: integer l_le(a,b,la,lb) ! 869: char *a, *b; ! 870: long int la, lb; ! 871: { ! 872: return(s_cmp(a,b,la,lb) <= 0); ! 873: } ! 874: ./ ADD NAME=libF77/l_lt.c TIME=628437509 ! 875: #include "f2c.h" ! 876: ! 877: integer l_lt(a,b,la,lb) ! 878: char *a, *b; ! 879: long la, lb; ! 880: { ! 881: return(s_cmp(a,b,la,lb) < 0); ! 882: } ! 883: ./ ADD NAME=libF77/main.c TIME=628524317 ! 884: /* STARTUP PROCEDURE FOR UNIX FORTRAN PROGRAMS */ ! 885: ! 886: #include "stdio.h" ! 887: #include "signal.h" ! 888: ! 889: #ifndef SIGIOT ! 890: #define SIGIOT SIGABRT ! 891: #endif ! 892: ! 893: #ifdef NO__STDC ! 894: #define ONEXIT onexit ! 895: extern void f_exit(); ! 896: #else ! 897: #ifdef __STDC__ ! 898: #include "stdlib.h" ! 899: extern void f_exit(void); ! 900: #ifndef NO_ONEXIT ! 901: #define ONEXIT atexit ! 902: extern int atexit(void (*)(void)); ! 903: #endif ! 904: #else ! 905: #ifndef NO_ONEXIT ! 906: #define ONEXIT onexit ! 907: extern void f_exit(); ! 908: #endif ! 909: #endif ! 910: #endif ! 911: ! 912: static void sigdie(s, kill) ! 913: register char *s; ! 914: int kill; ! 915: { ! 916: /* print error message, then clear buffers */ ! 917: fflush(stderr); ! 918: fprintf(stderr, "%s\n", s); ! 919: f_exit(); ! 920: fflush(stderr); ! 921: ! 922: if(kill) ! 923: { ! 924: /* now get a core */ ! 925: signal(SIGIOT, 0); ! 926: abort(); ! 927: } ! 928: else ! 929: exit(1); ! 930: } ! 931: ! 932: static void sigfdie(n) ! 933: { ! 934: sigdie("Floating Exception", 1); ! 935: } ! 936: ! 937: ! 938: ! 939: static void sigidie(n) ! 940: { ! 941: sigdie("IOT Trap", 1); ! 942: } ! 943: ! 944: ! 945: static void sigqdie(n) ! 946: { ! 947: sigdie("Quit signal", 1); ! 948: } ! 949: ! 950: ! 951: ! 952: static void sigindie(n) ! 953: { ! 954: sigdie("Interrupt", 0); ! 955: } ! 956: ! 957: ! 958: ! 959: static void sigtdie(n) ! 960: { ! 961: sigdie("Killed", 0); ! 962: } ! 963: ! 964: ! 965: int xargc; ! 966: char **xargv; ! 967: ! 968: main(argc, argv) ! 969: int argc; ! 970: char **argv; ! 971: { ! 972: xargc = argc; ! 973: xargv = argv; ! 974: signal(SIGFPE, sigfdie); /* ignore underflow, enable overflow */ ! 975: signal(SIGIOT, sigidie); ! 976: #ifdef SIGQUIT ! 977: if( (int)signal(SIGQUIT,sigqdie) & 01) signal(SIGQUIT, SIG_IGN); ! 978: #endif ! 979: if( (int)signal(SIGINT, sigindie) & 01) signal(SIGINT, SIG_IGN); ! 980: signal(SIGTERM,sigtdie); ! 981: ! 982: #ifdef pdp11 ! 983: ldfps(01200); /* detect overflow as an exception */ ! 984: #endif ! 985: ! 986: f_init(); ! 987: #ifndef NO_ONEXIT ! 988: ONEXIT(f_exit); ! 989: #endif ! 990: MAIN__(); ! 991: #ifdef NO_ONEXIT ! 992: f_exit(); ! 993: #endif ! 994: } ! 995: ./ ADD NAME=libF77/pow_ci.c TIME=628438069 ! 996: #include "f2c.h" ! 997: ! 998: VOID pow_ci(p, a, b) /* p = a**b */ ! 999: complex *p, *a; ! 1000: integer *b; ! 1001: { ! 1002: doublecomplex p1, a1; ! 1003: ! 1004: a1.r = a->r; ! 1005: a1.i = a->i; ! 1006: ! 1007: pow_zi(&p1, &a1, b); ! 1008: ! 1009: p->r = p1.r; ! 1010: p->i = p1.i; ! 1011: } ! 1012: ./ ADD NAME=libF77/pow_dd.c TIME=628437509 ! 1013: #include "f2c.h" ! 1014: ! 1015: double pow_dd(ap, bp) ! 1016: doublereal *ap, *bp; ! 1017: { ! 1018: double pow(); ! 1019: ! 1020: return(pow(*ap, *bp) ); ! 1021: } ! 1022: ./ ADD NAME=libF77/pow_di.c TIME=628437509 ! 1023: #include "f2c.h" ! 1024: ! 1025: double pow_di(ap, bp) ! 1026: doublereal *ap; ! 1027: integer *bp; ! 1028: { ! 1029: double pow, x; ! 1030: integer n; ! 1031: ! 1032: pow = 1; ! 1033: x = *ap; ! 1034: n = *bp; ! 1035: ! 1036: if(n != 0) ! 1037: { ! 1038: if(n < 0) ! 1039: { ! 1040: if(x == 0) ! 1041: { ! 1042: return(pow); ! 1043: } ! 1044: n = -n; ! 1045: x = 1/x; ! 1046: } ! 1047: for( ; ; ) ! 1048: { ! 1049: if(n & 01) ! 1050: pow *= x; ! 1051: if(n >>= 1) ! 1052: x *= x; ! 1053: else ! 1054: break; ! 1055: } ! 1056: } ! 1057: return(pow); ! 1058: } ! 1059: ./ ADD NAME=libF77/pow_hh.c TIME=628437509 ! 1060: #include "f2c.h" ! 1061: ! 1062: shortint pow_hh(ap, bp) ! 1063: shortint *ap, *bp; ! 1064: { ! 1065: shortint pow, x, n; ! 1066: ! 1067: pow = 1; ! 1068: x = *ap; ! 1069: n = *bp; ! 1070: ! 1071: if(n < 0) ! 1072: { } ! 1073: else if(n > 0) ! 1074: for( ; ; ) ! 1075: { ! 1076: if(n & 01) ! 1077: pow *= x; ! 1078: if(n >>= 1) ! 1079: x *= x; ! 1080: else ! 1081: break; ! 1082: } ! 1083: return(pow); ! 1084: } ! 1085: ./ ADD NAME=libF77/pow_ii.c TIME=628437509 ! 1086: #include "f2c.h" ! 1087: ! 1088: integer pow_ii(ap, bp) ! 1089: integer *ap, *bp; ! 1090: { ! 1091: integer pow, x, n; ! 1092: ! 1093: pow = 1; ! 1094: x = *ap; ! 1095: n = *bp; ! 1096: ! 1097: if(n < 0) ! 1098: { } ! 1099: else if(n > 0) ! 1100: for( ; ; ) ! 1101: { ! 1102: if(n & 01) ! 1103: pow *= x; ! 1104: if(n >>= 1) ! 1105: x *= x; ! 1106: else ! 1107: break; ! 1108: } ! 1109: return(pow); ! 1110: } ! 1111: ./ ADD NAME=libF77/pow_ri.c TIME=628437509 ! 1112: #include "f2c.h" ! 1113: ! 1114: double pow_ri(ap, bp) ! 1115: real *ap; ! 1116: integer *bp; ! 1117: { ! 1118: double pow, x; ! 1119: integer n; ! 1120: ! 1121: pow = 1; ! 1122: x = *ap; ! 1123: n = *bp; ! 1124: ! 1125: if(n != 0) ! 1126: { ! 1127: if(n < 0) ! 1128: { ! 1129: if(x == 0) ! 1130: { ! 1131: return(pow); ! 1132: } ! 1133: n = -n; ! 1134: x = 1/x; ! 1135: } ! 1136: for( ; ; ) ! 1137: { ! 1138: if(n & 01) ! 1139: pow *= x; ! 1140: if(n >>= 1) ! 1141: x *= x; ! 1142: else ! 1143: break; ! 1144: } ! 1145: } ! 1146: return(pow); ! 1147: } ! 1148: ./ ADD NAME=libF77/pow_zi.c TIME=628438134 ! 1149: #include "f2c.h" ! 1150: ! 1151: VOID pow_zi(p, a, b) /* p = a**b */ ! 1152: doublecomplex *p, *a; ! 1153: integer *b; ! 1154: { ! 1155: integer n; ! 1156: double t; ! 1157: doublecomplex x; ! 1158: static doublecomplex one = {1.0, 0.0}; ! 1159: ! 1160: n = *b; ! 1161: p->r = 1; ! 1162: p->i = 0; ! 1163: ! 1164: if(n == 0) ! 1165: return; ! 1166: if(n < 0) ! 1167: { ! 1168: n = -n; ! 1169: z_div(&x, &one, a); ! 1170: } ! 1171: else ! 1172: { ! 1173: x.r = a->r; ! 1174: x.i = a->i; ! 1175: } ! 1176: ! 1177: for( ; ; ) ! 1178: { ! 1179: if(n & 01) ! 1180: { ! 1181: t = p->r * x.r - p->i * x.i; ! 1182: p->i = p->r * x.i + p->i * x.r; ! 1183: p->r = t; ! 1184: } ! 1185: if(n >>= 1) ! 1186: { ! 1187: t = x.r * x.r - x.i * x.i; ! 1188: x.i = 2 * x.r * x.i; ! 1189: x.r = t; ! 1190: } ! 1191: else ! 1192: break; ! 1193: } ! 1194: } ! 1195: ./ ADD NAME=libF77/pow_zz.c TIME=628437510 ! 1196: #include "f2c.h" ! 1197: ! 1198: VOID pow_zz(r,a,b) ! 1199: doublecomplex *r, *a, *b; ! 1200: { ! 1201: double logr, logi, x, y; ! 1202: double log(), exp(), cos(), sin(), atan2(), cabs(); ! 1203: ! 1204: logr = log( cabs(a->r, a->i) ); ! 1205: logi = atan2(a->i, a->r); ! 1206: ! 1207: x = exp( logr * b->r - logi * b->i ); ! 1208: y = logr * b->i + logi * b->r; ! 1209: ! 1210: r->r = x * cos(y); ! 1211: r->i = x * sin(y); ! 1212: } ! 1213: ./ ADD NAME=libF77/r_abs.c TIME=628437510 ! 1214: #include "f2c.h" ! 1215: ! 1216: double r_abs(x) ! 1217: real *x; ! 1218: { ! 1219: if(*x >= 0) ! 1220: return(*x); ! 1221: return(- *x); ! 1222: } ! 1223: ./ ADD NAME=libF77/r_acos.c TIME=628437510 ! 1224: #include "f2c.h" ! 1225: ! 1226: double r_acos(x) ! 1227: real *x; ! 1228: { ! 1229: double acos(); ! 1230: return( acos(*x) ); ! 1231: } ! 1232: ./ ADD NAME=libF77/r_asin.c TIME=628437510 ! 1233: #include "f2c.h" ! 1234: ! 1235: double r_asin(x) ! 1236: real *x; ! 1237: { ! 1238: double asin(); ! 1239: return( asin(*x) ); ! 1240: } ! 1241: ./ ADD NAME=libF77/r_atan.c TIME=628437510 ! 1242: #include "f2c.h" ! 1243: ! 1244: double r_atan(x) ! 1245: real *x; ! 1246: { ! 1247: double atan(); ! 1248: return( atan(*x) ); ! 1249: } ! 1250: ./ ADD NAME=libF77/r_atn2.c TIME=628437510 ! 1251: #include "f2c.h" ! 1252: ! 1253: double r_atn2(x,y) ! 1254: real *x, *y; ! 1255: { ! 1256: double atan2(); ! 1257: return( atan2(*x,*y) ); ! 1258: } ! 1259: ./ ADD NAME=libF77/r_cnjg.c TIME=628437511 ! 1260: #include "f2c.h" ! 1261: ! 1262: VOID r_cnjg(r, z) ! 1263: complex *r, *z; ! 1264: { ! 1265: r->r = z->r; ! 1266: r->i = - z->i; ! 1267: } ! 1268: ./ ADD NAME=libF77/r_cos.c TIME=628437511 ! 1269: #include "f2c.h" ! 1270: ! 1271: double r_cos(x) ! 1272: real *x; ! 1273: { ! 1274: double cos(); ! 1275: return( cos(*x) ); ! 1276: } ! 1277: ./ ADD NAME=libF77/r_cosh.c TIME=628437511 ! 1278: #include "f2c.h" ! 1279: ! 1280: double r_cosh(x) ! 1281: real *x; ! 1282: { ! 1283: double cosh(); ! 1284: return( cosh(*x) ); ! 1285: } ! 1286: ./ ADD NAME=libF77/r_dim.c TIME=628437511 ! 1287: #include "f2c.h" ! 1288: ! 1289: double r_dim(a,b) ! 1290: real *a, *b; ! 1291: { ! 1292: return( *a > *b ? *a - *b : 0); ! 1293: } ! 1294: ./ ADD NAME=libF77/r_exp.c TIME=628437511 ! 1295: #include "f2c.h" ! 1296: ! 1297: double r_exp(x) ! 1298: real *x; ! 1299: { ! 1300: double exp(); ! 1301: return( exp(*x) ); ! 1302: } ! 1303: ./ ADD NAME=libF77/r_imag.c TIME=628437511 ! 1304: #include "f2c.h" ! 1305: ! 1306: double r_imag(z) ! 1307: complex *z; ! 1308: { ! 1309: return(z->i); ! 1310: } ! 1311: ./ ADD NAME=libF77/r_int.c TIME=628437511 ! 1312: #include "f2c.h" ! 1313: ! 1314: double r_int(x) ! 1315: real *x; ! 1316: { ! 1317: double floor(); ! 1318: ! 1319: return( (*x>0) ? floor(*x) : -floor(- *x) ); ! 1320: } ! 1321: ./ ADD NAME=libF77/r_lg10.c TIME=628437511 ! 1322: #include "f2c.h" ! 1323: ! 1324: #define log10e 0.43429448190325182765 ! 1325: ! 1326: double r_lg10(x) ! 1327: real *x; ! 1328: { ! 1329: double log(); ! 1330: ! 1331: return( log10e * log(*x) ); ! 1332: } ! 1333: ./ ADD NAME=libF77/r_log.c TIME=628437511 ! 1334: #include "f2c.h" ! 1335: ! 1336: double r_log(x) ! 1337: real *x; ! 1338: { ! 1339: double log(); ! 1340: return( log(*x) ); ! 1341: } ! 1342: ./ ADD NAME=libF77/r_mod.c TIME=628437512 ! 1343: #include "f2c.h" ! 1344: ! 1345: double r_mod(x,y) ! 1346: real *x, *y; ! 1347: { ! 1348: double floor(), quotient; ! 1349: if( (quotient = *x / *y) >= 0) ! 1350: quotient = floor(quotient); ! 1351: else ! 1352: quotient = -floor(-quotient); ! 1353: return(*x - (*y) * quotient ); ! 1354: } ! 1355: ./ ADD NAME=libF77/r_nint.c TIME=628437512 ! 1356: #include "f2c.h" ! 1357: ! 1358: double r_nint(x) ! 1359: real *x; ! 1360: { ! 1361: double floor(); ! 1362: ! 1363: return( (*x)>=0 ? ! 1364: floor(*x + .5) : -floor(.5 - *x) ); ! 1365: } ! 1366: ./ ADD NAME=libF77/r_sign.c TIME=628437512 ! 1367: #include "f2c.h" ! 1368: ! 1369: double r_sign(a,b) ! 1370: real *a, *b; ! 1371: { ! 1372: double x; ! 1373: x = (*a >= 0 ? *a : - *a); ! 1374: return( *b >= 0 ? x : -x); ! 1375: } ! 1376: ./ ADD NAME=libF77/r_sin.c TIME=628437512 ! 1377: #include "f2c.h" ! 1378: ! 1379: double r_sin(x) ! 1380: real *x; ! 1381: { ! 1382: double sin(); ! 1383: return( sin(*x) ); ! 1384: } ! 1385: ./ ADD NAME=libF77/r_sinh.c TIME=628437512 ! 1386: #include "f2c.h" ! 1387: ! 1388: double r_sinh(x) ! 1389: real *x; ! 1390: { ! 1391: double sinh(); ! 1392: return( sinh(*x) ); ! 1393: } ! 1394: ./ ADD NAME=libF77/r_sqrt.c TIME=628437512 ! 1395: #include "f2c.h" ! 1396: ! 1397: double r_sqrt(x) ! 1398: real *x; ! 1399: { ! 1400: double sqrt(); ! 1401: return( sqrt(*x) ); ! 1402: } ! 1403: ./ ADD NAME=libF77/r_tan.c TIME=628437512 ! 1404: #include "f2c.h" ! 1405: ! 1406: double r_tan(x) ! 1407: real *x; ! 1408: { ! 1409: double tan(); ! 1410: return( tan(*x) ); ! 1411: } ! 1412: ./ ADD NAME=libF77/r_tanh.c TIME=628437512 ! 1413: #include "f2c.h" ! 1414: ! 1415: double r_tanh(x) ! 1416: real *x; ! 1417: { ! 1418: double tanh(); ! 1419: return( tanh(*x) ); ! 1420: } ! 1421: ./ ADD NAME=libF77/s_cat.c TIME=628437513 ! 1422: #include "f2c.h" ! 1423: ! 1424: VOID s_cat(lp, rpp, rnp, np, ll) ! 1425: char *lp, *rpp[]; ! 1426: #ifdef f2c_i2 ! 1427: short int rnp[], *np, ll; ! 1428: #else ! 1429: long int rnp[], *np, ll; ! 1430: #endif ! 1431: { ! 1432: int i, n, nc; ! 1433: char *rp; ! 1434: ! 1435: n = *np; ! 1436: for(i = 0 ; i < n ; ++i) ! 1437: { ! 1438: nc = ll; ! 1439: if(rnp[i] < nc) ! 1440: nc = rnp[i]; ! 1441: ll -= nc; ! 1442: rp = rpp[i]; ! 1443: while(--nc >= 0) ! 1444: *lp++ = *rp++; ! 1445: } ! 1446: while(--ll >= 0) ! 1447: *lp++ = ' '; ! 1448: } ! 1449: ./ ADD NAME=libF77/s_cmp.c TIME=628437513 ! 1450: #include "f2c.h" ! 1451: ! 1452: integer s_cmp(a, b, la, lb) /* compare two strings */ ! 1453: register char *a, *b; ! 1454: long int la, lb; ! 1455: { ! 1456: register char *aend, *bend; ! 1457: aend = a + la; ! 1458: bend = b + lb; ! 1459: ! 1460: if(la <= lb) ! 1461: { ! 1462: while(a < aend) ! 1463: if(*a != *b) ! 1464: return( *a - *b ); ! 1465: else ! 1466: { ++a; ++b; } ! 1467: ! 1468: while(b < bend) ! 1469: if(*b != ' ') ! 1470: return( ' ' - *b ); ! 1471: else ++b; ! 1472: } ! 1473: ! 1474: else ! 1475: { ! 1476: while(b < bend) ! 1477: if(*a == *b) ! 1478: { ++a; ++b; } ! 1479: else ! 1480: return( *a - *b ); ! 1481: while(a < aend) ! 1482: if(*a != ' ') ! 1483: return(*a - ' '); ! 1484: else ++a; ! 1485: } ! 1486: return(0); ! 1487: } ! 1488: ./ ADD NAME=libF77/s_copy.c TIME=628437513 ! 1489: #include "f2c.h" ! 1490: ! 1491: VOID s_copy(a, b, la, lb) /* assign strings: a = b */ ! 1492: char *a, *b; ! 1493: long int la, lb; ! 1494: { ! 1495: char *aend, *bend; ! 1496: ! 1497: aend = a + la; ! 1498: ! 1499: if(la <= lb) ! 1500: while(a < aend) ! 1501: *a++ = *b++; ! 1502: ! 1503: else ! 1504: { ! 1505: bend = b + lb; ! 1506: while(b < bend) ! 1507: *a++ = *b++; ! 1508: while(a < aend) ! 1509: *a++ = ' '; ! 1510: } ! 1511: } ! 1512: ./ ADD NAME=libF77/s_paus.c TIME=628474922 ! 1513: #include "stdio.h" ! 1514: #include "f2c.h" ! 1515: #define PAUSESIG 15 ! 1516: ! 1517: static waitpause() ! 1518: { ! 1519: return; ! 1520: } ! 1521: ! 1522: VOID s_paus(s, n) ! 1523: char *s; ! 1524: long int n; ! 1525: { ! 1526: int i; ! 1527: ! 1528: fprintf(stderr, "PAUSE "); ! 1529: if(n > 0) ! 1530: for(i = 0; i<n ; ++i) ! 1531: putc(*s++, stderr); ! 1532: fprintf(stderr, " statement executed\n"); ! 1533: if( isatty(fileno(stdin)) ) ! 1534: { ! 1535: fprintf(stderr, "To resume execution, type go. Any other input will terminate job.\n"); ! 1536: fflush(stderr); ! 1537: if( getchar()!='g' || getchar()!='o' || getchar()!='\n' ) ! 1538: { ! 1539: fprintf(stderr, "STOP\n"); ! 1540: f_exit(); ! 1541: exit(0); ! 1542: } ! 1543: } ! 1544: else ! 1545: { ! 1546: fprintf(stderr, "To resume execution, execute a kill -%d %d command\n", ! 1547: PAUSESIG, getpid() ); ! 1548: signal(PAUSESIG, waitpause); ! 1549: fflush(stderr); ! 1550: pause(); ! 1551: } ! 1552: fprintf(stderr, "Execution resumes after PAUSE.\n"); ! 1553: } ! 1554: ./ ADD NAME=libF77/s_rnge.c TIME=626022810 ! 1555: #include <stdio.h> ! 1556: ! 1557: /* called when a subscript is out of range */ ! 1558: ! 1559: s_rnge(varn, offset, procn, line) ! 1560: char *varn, *procn; ! 1561: long int offset; ! 1562: int line; ! 1563: { ! 1564: register int i; ! 1565: ! 1566: fprintf(stderr, "Subscript out of range on file line %d, procedure ", line); ! 1567: for(i = 0 ; i < 8 && *procn!='_' ; ++i) ! 1568: putc(*procn++, stderr); ! 1569: fprintf(stderr, ".\nAttempt to access the %ld-th element of variable ", offset+1); ! 1570: for(i = 0 ; i < 8 && *varn!=' ' ; ++i) ! 1571: putc(*varn++, stderr); ! 1572: fprintf(stderr, ".\n"); ! 1573: _cleanup(); ! 1574: abort(); ! 1575: } ! 1576: ./ ADD NAME=libF77/s_stop.c TIME=628474936 ! 1577: #include "stdio.h" ! 1578: #include "f2c.h" ! 1579: ! 1580: VOID s_stop(s, n) ! 1581: char *s; ! 1582: long int n; ! 1583: { ! 1584: int i; ! 1585: ! 1586: if(n > 0) ! 1587: { ! 1588: fprintf(stderr, "STOP "); ! 1589: for(i = 0; i<n ; ++i) ! 1590: putc(*s++, stderr); ! 1591: fprintf(stderr, " statement executed\n"); ! 1592: } ! 1593: f_exit(); ! 1594: exit(0); ! 1595: } ! 1596: ./ ADD NAME=libF77/signal_.c TIME=628437513 ! 1597: #include "f2c.h" ! 1598: ! 1599: typedef int (*sig_type)(); ! 1600: extern sig_type signal(); ! 1601: ! 1602: integer signal_(sigp, procp) ! 1603: integer *sigp, *procp; ! 1604: { ! 1605: int sig; ! 1606: sig_type proc; ! 1607: sig = *sigp; ! 1608: proc = *(sig_type *)procp; ! 1609: ! 1610: return (integer)signal(sig, proc); ! 1611: } ! 1612: ./ ADD NAME=libF77/system_.c TIME=628437513 ! 1613: /* f77 interface to system routine */ ! 1614: ! 1615: #include "f2c.h" ! 1616: ! 1617: system_(s, n) ! 1618: register char *s; ! 1619: long int n; ! 1620: { ! 1621: char buff[1000]; ! 1622: register char *bp, *blast; ! 1623: ! 1624: blast = buff + (n < 1000 ? n : 1000); ! 1625: ! 1626: for(bp = buff ; bp<blast && *s!='\0' ; ) ! 1627: *bp++ = *s++; ! 1628: *bp = '\0'; ! 1629: system(buff); ! 1630: } ! 1631: ./ ADD NAME=libF77/z_abs.c TIME=628438260 ! 1632: #include "f2c.h" ! 1633: ! 1634: double z_abs(z) ! 1635: doublecomplex *z; ! 1636: { ! 1637: double cabs(); ! 1638: ! 1639: return( cabs( z->r, z->i ) ); ! 1640: } ! 1641: ./ ADD NAME=libF77/z_cos.c TIME=628437514 ! 1642: #include "f2c.h" ! 1643: ! 1644: VOID z_cos(r, z) ! 1645: doublecomplex *r, *z; ! 1646: { ! 1647: double sin(), cos(), sinh(), cosh(); ! 1648: ! 1649: r->r = cos(z->r) * cosh(z->i); ! 1650: r->i = - sin(z->r) * sinh(z->i); ! 1651: } ! 1652: ./ ADD NAME=libF77/z_div.c TIME=628437514 ! 1653: #include "f2c.h" ! 1654: ! 1655: VOID z_div(c, a, b) ! 1656: doublecomplex *a, *b, *c; ! 1657: { ! 1658: double ratio, den; ! 1659: double abr, abi; ! 1660: ! 1661: if( (abr = b->r) < 0.) ! 1662: abr = - abr; ! 1663: if( (abi = b->i) < 0.) ! 1664: abi = - abi; ! 1665: if( abr <= abi ) ! 1666: { ! 1667: if(abi == 0) ! 1668: abort(); /* fatal("complex division by zero"); */ ! 1669: ratio = b->r / b->i ; ! 1670: den = b->i * (1 + ratio*ratio); ! 1671: c->r = (a->r*ratio + a->i) / den; ! 1672: c->i = (a->i*ratio - a->r) / den; ! 1673: } ! 1674: ! 1675: else ! 1676: { ! 1677: ratio = b->i / b->r ; ! 1678: den = b->r * (1 + ratio*ratio); ! 1679: c->r = (a->r + a->i*ratio) / den; ! 1680: c->i = (a->i - a->r*ratio) / den; ! 1681: } ! 1682: ! 1683: } ! 1684: ./ ADD NAME=libF77/z_exp.c TIME=628437514 ! 1685: #include "f2c.h" ! 1686: ! 1687: VOID z_exp(r, z) ! 1688: doublecomplex *r, *z; ! 1689: { ! 1690: double expx; ! 1691: double exp(), cos(), sin(); ! 1692: ! 1693: expx = exp(z->r); ! 1694: r->r = expx * cos(z->i); ! 1695: r->i = expx * sin(z->i); ! 1696: } ! 1697: ./ ADD NAME=libF77/z_log.c TIME=628437514 ! 1698: #include "f2c.h" ! 1699: ! 1700: VOID z_log(r, z) ! 1701: doublecomplex *r, *z; ! 1702: { ! 1703: double log(), cabs(), atan2(); ! 1704: ! 1705: r->i = atan2(z->i, z->r); ! 1706: r->r = log( cabs( z->r, z->i ) ); ! 1707: } ! 1708: ./ ADD NAME=libF77/z_sin.c TIME=628437514 ! 1709: #include "f2c.h" ! 1710: ! 1711: VOID z_sin(r, z) ! 1712: doublecomplex *r, *z; ! 1713: { ! 1714: double sin(), cos(), sinh(), cosh(); ! 1715: ! 1716: r->r = sin(z->r) * cosh(z->i); ! 1717: r->i = cos(z->r) * sinh(z->i); ! 1718: } ! 1719: ./ ADD NAME=libF77/z_sqrt.c TIME=628437514 ! 1720: #include "f2c.h" ! 1721: ! 1722: VOID z_sqrt(r, z) ! 1723: doublecomplex *r, *z; ! 1724: { ! 1725: double mag, sqrt(), cabs(); ! 1726: ! 1727: if( (mag = cabs(z->r, z->i)) == 0.) ! 1728: r->r = r->i = 0.; ! 1729: else if(z->r > 0) ! 1730: { ! 1731: r->r = sqrt(0.5 * (mag + z->r) ); ! 1732: r->i = z->i / r->r / 2; ! 1733: } ! 1734: else ! 1735: { ! 1736: r->i = sqrt(0.5 * (mag - z->r) ); ! 1737: if(z->i < 0) ! 1738: z->i = - z->i; ! 1739: r->r = z->i / r->i / 2; ! 1740: } ! 1741: } ! 1742: ./ ENDUP
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.