![]() ![]() | ![]() |
Passage de la branche 4.1 en branche stable.
1: C=============================================================================== 2: C RPL/2 (R) version 4.1.0 3: C Copyright (C) 1989-2011 Dr. BERTRAND Joël 4: C 5: C This file is part of RPL/2. 6: C 7: C RPL/2 is free software; you can redistribute it and/or modify it 8: C under the terms of the CeCILL V2 License as published by the french 9: C CEA, CNRS and INRIA. 10: C 11: C RPL/2 is distributed in the hope that it will be useful, but WITHOUT 12: C ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 13: C FITNESS FOR A PARTICULAR PURPOSE. See the CeCILL V2 License 14: C for more details. 15: C 16: C You should have received a copy of the CeCILL License 17: C along with RPL/2. If not, write to info@cecill.info. 18: C=============================================================================== 19: 20: 21: C-- Addition ------------------------------------------------------------------- 22: 23: subroutine F77ADDITIONCI(CA, IB, RESULTAT) 24: 25: implicit none 26: 27: complex*16 CA 28: complex*16 CB 29: complex*16 RESULTAT 30: 31: integer*8 IB 32: 33: CB = dcmplx(IB) 34: RESULTAT = CA + CB 35: 36: return 37: end 38: 39: 40: subroutine F77ADDITIONCC(CA, CB, RESULTAT) 41: 42: implicit none 43: 44: complex*16 CA 45: complex*16 CB 46: complex*16 RESULTAT 47: 48: RESULTAT = CA + CB 49: 50: return 51: end 52: 53: 54: subroutine F77ADDITIONCR(CA, RB, RESULTAT) 55: 56: implicit none 57: 58: complex*16 CA 59: complex*16 CB 60: complex*16 RESULTAT 61: 62: real*8 RB 63: 64: CB = dcmplx(RB) 65: RESULTAT = CA + CB 66: 67: return 68: end 69: 70: C-- Multiplication ------------------------------------------------------------- 71: 72: subroutine F77MULTIPLICATIONCI(CA, IB, RESULTAT) 73: 74: implicit none 75: 76: complex*16 CA 77: complex*16 CB 78: complex*16 RESULTAT 79: 80: integer*8 IB 81: 82: CB = dcmplx(IB) 83: RESULTAT = CA * CB 84: 85: return 86: end 87: 88: 89: subroutine F77MULTIPLICATIONCC(CA, CB, RESULTAT) 90: 91: implicit none 92: 93: complex*16 CA 94: complex*16 CB 95: complex*16 RESULTAT 96: 97: RESULTAT = CA * CB 98: 99: return 100: end 101: 102: 103: subroutine F77MULTIPLICATIONCR(CA, RB, RESULTAT) 104: 105: implicit none 106: 107: complex*16 CA 108: complex*16 CB 109: complex*16 RESULTAT 110: 111: real*8 RB 112: 113: CB = dcmplx(RB) 114: RESULTAT = CA * CB 115: 116: return 117: end 118: 119: C-- Soustraction --------------------------------------------------------------- 120: 121: subroutine F77SOUSTRACTIONCI(CA, IB, RESULTAT) 122: 123: implicit none 124: 125: complex*16 CA 126: complex*16 CB 127: complex*16 RESULTAT 128: 129: integer*8 IB 130: 131: CB = dcmplx(IB) 132: RESULTAT = CA - CB 133: 134: return 135: end 136: 137: 138: subroutine F77SOUSTRACTIONIC(IA, CB, RESULTAT) 139: 140: implicit none 141: 142: complex*16 CA 143: complex*16 CB 144: complex*16 RESULTAT 145: 146: integer*8 IA 147: 148: CA = dcmplx(IA) 149: RESULTAT = CA - CB 150: 151: return 152: end 153: 154: 155: subroutine F77SOUSTRACTIONCC(CA, CB, RESULTAT) 156: 157: implicit none 158: 159: complex*16 CA 160: complex*16 CB 161: complex*16 RESULTAT 162: 163: RESULTAT = CA - CB 164: 165: return 166: end 167: 168: 169: subroutine F77SOUSTRACTIONCR(CA, RB, RESULTAT) 170: 171: implicit none 172: 173: complex*16 CA 174: complex*16 CB 175: complex*16 RESULTAT 176: 177: real*8 RB 178: 179: CB = dcmplx(RB) 180: RESULTAT = CA - CB 181: 182: return 183: end 184: 185: 186: subroutine F77SOUSTRACTIONRC(RA, CB, RESULTAT) 187: 188: implicit none 189: 190: complex*16 CA 191: complex*16 CB 192: complex*16 RESULTAT 193: 194: real*8 RA 195: 196: CA = dcmplx(RA) 197: RESULTAT = CA - CB 198: 199: return 200: end 201: 202: C-- Division ------------------------------------------------------------------- 203: 204: subroutine F77DIVISIONCI(CA, IB, RESULTAT) 205: 206: implicit none 207: 208: complex*16 CA 209: complex*16 CB 210: complex*16 RESULTAT 211: 212: integer*8 IB 213: 214: CB = dcmplx(IB) 215: RESULTAT = CA / CB 216: 217: return 218: end 219: 220: 221: subroutine F77DIVISIONIC(IA, CB, RESULTAT) 222: 223: implicit none 224: 225: complex*16 CA 226: complex*16 CB 227: complex*16 RESULTAT 228: 229: integer*8 IA 230: 231: CA = dcmplx(IA) 232: RESULTAT = CA / CB 233: 234: return 235: end 236: 237: 238: subroutine F77DIVISIONCC(CA, CB, RESULTAT) 239: 240: implicit none 241: 242: complex*16 CA 243: complex*16 CB 244: complex*16 RESULTAT 245: 246: RESULTAT = CA / CB 247: 248: return 249: end 250: 251: 252: subroutine F77DIVISIONCR(CA, RB, RESULTAT) 253: 254: implicit none 255: 256: complex*16 CA 257: complex*16 CB 258: complex*16 RESULTAT 259: 260: real*8 RB 261: 262: CB = dcmplx(RB) 263: RESULTAT = CA / CB 264: 265: return 266: end 267: 268: 269: subroutine F77DIVISIONRC(RA, CB, RESULTAT) 270: 271: implicit none 272: 273: complex*16 CA 274: complex*16 CB 275: complex*16 RESULTAT 276: 277: real*8 RA 278: 279: CA = dcmplx(RA) 280: RESULTAT = CA / CB 281: 282: return 283: end 284: 285: C-- Puissance ------------------------------------------------------------------ 286: 287: subroutine F77PUISSANCEII(IA, IB, RESULTAT) 288: 289: implicit none 290: 291: integer*8 IA 292: integer*8 IB 293: integer*8 RESULTAT 294: 295: RESULTAT = IA ** IB 296: 297: return 298: end 299: 300: 301: subroutine F77PUISSANCEIR(IA, RB, RESULTAT) 302: 303: implicit none 304: 305: integer*8 IA 306: 307: real*8 RB 308: real*8 RESULTAT 309: 310: RESULTAT = IA ** RB 311: 312: return 313: end 314: 315: 316: subroutine F77PUISSANCEIC(IA, CB, RESULTAT) 317: 318: implicit none 319: 320: complex*16 CB 321: complex*16 RESULTAT 322: 323: integer*8 IA 324: 325: RESULTAT = IA ** CB 326: 327: return 328: end 329: 330: 331: subroutine F77PUISSANCERI(RA, IB, RESULTAT, TRONCATURE) 332: 333: implicit none 334: 335: integer*4 INTEGER4 336: integer*4 TRONCATURE 337: 338: integer*8 IB 339: 340: real*8 RA 341: real*8 RESULTAT 342: 343: C-- IB converti en integer*4 344: INTEGER4 = IB 345: 346: if (IB.ne.INTEGER4) then 347: TRONCATURE = -1 348: else 349: TRONCATURE = 0 350: end if 351: 352: RESULTAT = RA ** INTEGER4 353: 354: return 355: end 356: 357: 358: subroutine F77PUISSANCERR(RA, RB, RESULTAT) 359: 360: implicit none 361: 362: real*8 RA 363: real*8 RB 364: real*8 RESULTAT 365: 366: RESULTAT = RA ** RB 367: 368: return 369: end 370: 371: 372: subroutine F77PUISSANCERC(RA, CB, RESULTAT) 373: 374: implicit none 375: 376: complex*16 CB 377: complex*16 RESULTAT 378: 379: real*8 RA 380: 381: RESULTAT = RA ** CB 382: 383: return 384: end 385: 386: 387: subroutine F77PUISSANCECI(CA, IB, RESULTAT, TRONCATURE) 388: 389: implicit none 390: 391: complex*16 CA 392: complex*16 RESULTAT 393: 394: integer*4 INTEGER4 395: integer*4 TRONCATURE 396: 397: integer*8 IB 398: 399: C-- IB converti en integer*4 400: INTEGER4 = IB 401: 402: if (IB.ne.INTEGER4) then 403: TRONCATURE = -1 404: else 405: TRONCATURE = 0 406: end if 407: 408: RESULTAT = CA ** INTEGER4 409: 410: return 411: end 412: 413: 414: subroutine F77PUISSANCECR(CA, RB, RESULTAT) 415: 416: implicit none 417: 418: complex*16 CA 419: complex*16 RESULTAT 420: 421: real*8 RB 422: 423: RESULTAT = CA ** RB 424: 425: return 426: end 427: 428: 429: subroutine F77PUISSANCECC(CA, CB, RESULTAT) 430: 431: implicit none 432: 433: complex*16 CA 434: complex*16 CB 435: complex*16 RESULTAT 436: 437: RESULTAT = CA ** CB 438: 439: return 440: end 441: 442: C-- Racine carrée -------------------------------------------------------------- 443: 444: subroutine F77RACINECARREEIP(IA, RESULTAT) 445: 446: implicit none 447: 448: integer*8 IA 449: 450: real*8 RA 451: real*8 RESULTAT 452: 453: RA = dble(IA) 454: RESULTAT = sqrt(RA) 455: 456: return 457: end 458: 459: 460: subroutine F77RACINECARREEIN(IA, RESULTAT) 461: 462: implicit none 463: 464: complex*16 CA 465: complex*16 RESULTAT 466: 467: integer*8 IA 468: 469: CA = dcmplx(IA) 470: RESULTAT = sqrt(CA) 471: 472: return 473: end 474: 475: 476: subroutine F77RACINECARREERP(RA, RESULTAT) 477: 478: implicit none 479: 480: real*8 RA 481: real*8 RESULTAT 482: 483: RESULTAT = sqrt(RA) 484: 485: return 486: end 487: 488: 489: subroutine F77RACINECARREERN(RA, RESULTAT) 490: 491: implicit none 492: 493: complex*16 CA 494: complex*16 RESULTAT 495: 496: real*8 RA 497: 498: CA = dcmplx(RA) 499: RESULTAT = sqrt(CA) 500: 501: return 502: end 503: 504: 505: subroutine F77RACINECARREEC(CA, RESULTAT) 506: 507: implicit none 508: 509: complex*16 CA 510: complex*16 RESULTAT 511: 512: RESULTAT = sqrt(CA) 513: 514: return 515: end 516: 517: C-- Valeur absolue ------------------------------------------------------------- 518: 519: subroutine F77ABSC(C, RESULTAT) 520: 521: implicit none 522: 523: complex*16 C 524: 525: real*8 RESULTAT 526: 527: RESULTAT = ABS(C) 528: 529: return 530: end