Annotation of rpl/src/bibliotheque_logarithmique.f, revision 1.1
1.1 ! bertrand 1: C===============================================================================
! 2: C RPL/2 (R) version 4.0.9
! 3: C Copyright (C) 1989-2010 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===============================================================================
! 22: C Fonctions logarithmiques diverses
! 23: C===============================================================================
! 24:
! 25: C-------------------------------------------------------------------------------
! 26: C Logarithme naturel
! 27: C-------------------------------------------------------------------------------
! 28:
! 29: subroutine F77LNIP(ARGUMENT, RESULTAT, ERREUR)
! 30:
! 31: implicit none
! 32:
! 33: integer*4 ERREUR
! 34:
! 35: integer*8 ARGUMENT
! 36:
! 37: real*8 RESULTAT
! 38:
! 39: if (ARGUMENT.ne.0) then
! 40: RESULTAT = log(dble(ARGUMENT))
! 41: ERREUR = 0
! 42: else
! 43: RESULTAT = 0
! 44: ERREUR = -1
! 45: end if
! 46: return
! 47: end
! 48:
! 49: subroutine F77LNIN(ARGUMENT, RESULTAT, ERREUR)
! 50:
! 51: implicit none
! 52:
! 53: complex*16 RESULTAT
! 54:
! 55: integer*4 ERREUR
! 56:
! 57: integer*8 ARGUMENT
! 58:
! 59: if (ARGUMENT.ne.0) then
! 60: RESULTAT = log(dble(ARGUMENT) + (0,0))
! 61: ERREUR = 0
! 62: else
! 63: RESULTAT = 0
! 64: ERREUR = -1
! 65: end if
! 66: return
! 67: end
! 68:
! 69: subroutine F77LNRP(ARGUMENT, RESULTAT, ERREUR)
! 70:
! 71: implicit none
! 72:
! 73: integer*4 ERREUR
! 74:
! 75: real*8 ARGUMENT
! 76: real*8 RESULTAT
! 77:
! 78: if (ARGUMENT.ne.0) then
! 79: RESULTAT = log(ARGUMENT)
! 80: ERREUR = 0
! 81: else
! 82: RESULTAT = 0
! 83: ERREUR = -1
! 84: end if
! 85: return
! 86: end
! 87:
! 88: subroutine F77LNRN(ARGUMENT, RESULTAT, ERREUR)
! 89:
! 90: implicit none
! 91:
! 92: complex*16 RESULTAT
! 93:
! 94: integer*4 ERREUR
! 95:
! 96: real*8 ARGUMENT
! 97:
! 98: if (ARGUMENT.ne.0) then
! 99: RESULTAT = log(ARGUMENT + (0,0))
! 100: ERREUR = 0
! 101: else
! 102: RESULTAT = 0
! 103: ERREUR = -1
! 104: end if
! 105: return
! 106: end
! 107:
! 108: subroutine F77LNC(ARGUMENT, RESULTAT, ERREUR)
! 109:
! 110: implicit none
! 111:
! 112: complex*16 ARGUMENT
! 113: complex*16 RESULTAT
! 114:
! 115: integer*4 ERREUR
! 116:
! 117: if (ARGUMENT.ne.0) then
! 118: RESULTAT = log(ARGUMENT)
! 119: ERREUR = 0
! 120: else
! 121: RESULTAT = 0
! 122: ERREUR = -1
! 123: end if
! 124: return
! 125: end
! 126:
! 127: C-------------------------------------------------------------------------------
! 128: C Logarithme vulgaire
! 129: C-------------------------------------------------------------------------------
! 130:
! 131: subroutine F77LOGIP(ARGUMENT, RESULTAT, ERREUR)
! 132:
! 133: implicit none
! 134:
! 135: integer*4 ERREUR
! 136:
! 137: integer*8 ARGUMENT
! 138:
! 139: real*8 RESULTAT
! 140:
! 141: if (ARGUMENT.ne.0) then
! 142: RESULTAT = log(dble(ARGUMENT)) / log(1D1)
! 143: ERREUR = 0
! 144: else
! 145: RESULTAT = 0
! 146: ERREUR = -1
! 147: end if
! 148: return
! 149: end
! 150:
! 151: subroutine F77LOGIN(ARGUMENT, RESULTAT, ERREUR)
! 152:
! 153: implicit none
! 154:
! 155: complex*16 RESULTAT
! 156:
! 157: integer*4 ERREUR
! 158:
! 159: integer*8 ARGUMENT
! 160:
! 161: if (ARGUMENT.ne.0) then
! 162: RESULTAT = log(dble(ARGUMENT) + (0,0)) / log(1D1)
! 163: ERREUR = 0
! 164: else
! 165: RESULTAT = 0
! 166: ERREUR = -1
! 167: end if
! 168: return
! 169: end
! 170:
! 171: subroutine F77LOGRP(ARGUMENT, RESULTAT, ERREUR)
! 172:
! 173: implicit none
! 174:
! 175: integer*4 ERREUR
! 176:
! 177: real*8 ARGUMENT
! 178: real*8 RESULTAT
! 179:
! 180: if (ARGUMENT.ne.0) then
! 181: RESULTAT = log(ARGUMENT) / log(1D1)
! 182: ERREUR = 0
! 183: else
! 184: RESULTAT = 0
! 185: ERREUR = -1
! 186: end if
! 187: return
! 188: end
! 189:
! 190: subroutine F77LOGRN(ARGUMENT, RESULTAT, ERREUR)
! 191:
! 192: implicit none
! 193:
! 194: complex*16 RESULTAT
! 195: integer*4 ERREUR
! 196:
! 197: real*8 ARGUMENT
! 198:
! 199: if (ARGUMENT.ne.0) then
! 200: RESULTAT = log(ARGUMENT + (0,0)) / log(1D1)
! 201: ERREUR = 0
! 202: else
! 203: RESULTAT = 0
! 204: ERREUR = -1
! 205: end if
! 206: return
! 207: end
! 208:
! 209: subroutine F77LOGC(ARGUMENT, RESULTAT, ERREUR)
! 210:
! 211: implicit none
! 212:
! 213: complex*16 ARGUMENT
! 214: complex*16 RESULTAT
! 215:
! 216: integer*4 ERREUR
! 217:
! 218: if (ARGUMENT.ne.0) then
! 219: RESULTAT = log(ARGUMENT) / log(1D1)
! 220: ERREUR = 0
! 221: else
! 222: RESULTAT = 0
! 223: ERREUR = -1
! 224: end if
! 225: return
! 226: end
! 227:
! 228: C-------------------------------------------------------------------------------
! 229: C Sinus hyperbolique
! 230: C-------------------------------------------------------------------------------
! 231:
! 232: subroutine F77SINH(ARGUMENT, RESULTAT)
! 233:
! 234: implicit none
! 235:
! 236: complex*16 ARGUMENT
! 237: complex*16 RESULTAT
! 238:
! 239: RESULTAT = (exp(ARGUMENT) - exp(-ARGUMENT)) / 2
! 240: return
! 241: end
! 242:
! 243: subroutine F77ASINHC(ARGUMENT, RESULTAT)
! 244:
! 245: implicit none
! 246:
! 247: complex*16 ARGUMENT
! 248: complex*16 RESULTAT
! 249:
! 250: RESULTAT = log(ARGUMENT + sqrt((ARGUMENT ** 2) + 1))
! 251: return
! 252: end
! 253:
! 254: subroutine F77ASINHI(ARGUMENT, RESULTAT)
! 255:
! 256: implicit none
! 257:
! 258: integer*8 ARGUMENT
! 259: real*8 RESULTAT
! 260:
! 261: RESULTAT = log(ARGUMENT + sqrt((dble(ARGUMENT) ** 2) + 1))
! 262: return
! 263: end
! 264:
! 265: subroutine F77ASINHR(ARGUMENT, RESULTAT)
! 266:
! 267: implicit none
! 268:
! 269: real*8 ARGUMENT
! 270: real*8 RESULTAT
! 271:
! 272: RESULTAT = log(ARGUMENT + sqrt((dble(ARGUMENT) ** 2) + 1))
! 273: return
! 274: end
! 275:
! 276: C-------------------------------------------------------------------------------
! 277: C Cosinus hyperbolique
! 278: C-------------------------------------------------------------------------------
! 279:
! 280: subroutine F77COSH(ARGUMENT, RESULTAT)
! 281:
! 282: implicit none
! 283:
! 284: complex*16 ARGUMENT
! 285: complex*16 RESULTAT
! 286:
! 287: RESULTAT = (exp(ARGUMENT) + exp(-ARGUMENT)) / 2
! 288: return
! 289: end
! 290:
! 291: subroutine F77ACOSHC(ARGUMENT, RESULTAT)
! 292:
! 293: implicit none
! 294:
! 295: complex*16 ARGUMENT
! 296: complex*16 RESULTAT
! 297:
! 298: RESULTAT = log(ARGUMENT + sqrt((ARGUMENT ** 2) - 1))
! 299: return
! 300: end
! 301:
! 302: subroutine F77ACOSHI(ARGUMENT, RESULTAT)
! 303:
! 304: implicit none
! 305:
! 306: integer*8 ARGUMENT
! 307: real*8 RESULTAT
! 308:
! 309: RESULTAT = log(ARGUMENT + sqrt((dble(ARGUMENT) ** 2) - 1))
! 310: return
! 311: end
! 312:
! 313: subroutine F77ACOSHR(ARGUMENT, RESULTAT)
! 314:
! 315: implicit none
! 316:
! 317: real*8 ARGUMENT
! 318: real*8 RESULTAT
! 319:
! 320: RESULTAT = log(ARGUMENT + sqrt((dble(ARGUMENT) ** 2) - 1))
! 321: return
! 322: end
! 323:
! 324: C-------------------------------------------------------------------------------
! 325: C Tangente hyperbolique
! 326: C-------------------------------------------------------------------------------
! 327:
! 328: subroutine F77TANH(ARGUMENT, RESULTAT, ERREUR)
! 329:
! 330: implicit none
! 331:
! 332: complex*16 ARGUMENT
! 333: complex*16 COSINUSH
! 334: complex*16 RESULTAT
! 335: complex*16 SINUSH
! 336:
! 337: integer*4 ERREUR
! 338:
! 339: ERREUR = 0
! 340:
! 341: if (dimag(ARGUMENT).eq.0) then
! 342: RESULTAT = dtan(dble(ARGUMENT))
! 343: else
! 344: call F77COSH(ARGUMENT, COSINUSH)
! 345:
! 346: if (COSINUSH.ne.0) then
! 347: call F77SINH(ARGUMENT, SINUSH)
! 348: RESULTAT = SINUSH / COSINUSH
! 349: else
! 350: RESULTAT = 0
! 351: ERREUR = -1
! 352: end if
! 353: end if
! 354: return
! 355: end
! 356:
! 357: subroutine F77ATANHC(ARGUMENT, RESULTAT)
! 358:
! 359: implicit none
! 360:
! 361: complex*16 ARGUMENT
! 362: complex*16 RESULTAT
! 363:
! 364: RESULTAT = log((1 + ARGUMENT) / (1 - ARGUMENT)) / 2
! 365: return
! 366: end
! 367:
! 368: subroutine F77ATANHI(ARGUMENT, RESULTAT)
! 369:
! 370: implicit none
! 371:
! 372: integer*8 ARGUMENT
! 373: real*8 RESULTAT
! 374:
! 375: RESULTAT = log((1 + dble(ARGUMENT)) / (1 - dble(ARGUMENT))) / 2
! 376: return
! 377: end
! 378:
! 379: subroutine F77ATANHR(ARGUMENT, RESULTAT)
! 380:
! 381: implicit none
! 382:
! 383: real*8 ARGUMENT
! 384: real*8 RESULTAT
! 385:
! 386: RESULTAT = log((1 + ARGUMENT) / (1 - ARGUMENT)) / 2
! 387: return
! 388: end
! 389:
! 390: C-------------------------------------------------------------------------------
! 391: C Exponentielle complexe
! 392: C-------------------------------------------------------------------------------
! 393:
! 394: subroutine F77EXPC(ARGUMENT, RESULTAT)
! 395:
! 396: implicit none
! 397:
! 398: complex*16 ARGUMENT
! 399: complex*16 RESULTAT
! 400:
! 401: RESULTAT = exp(ARGUMENT)
! 402: return
! 403: end
! 404:
! 405: C-------------------------------------------------------------------------------
! 406: C Alog complexe
! 407: C-------------------------------------------------------------------------------
! 408:
! 409: subroutine F77ALOGC(ARGUMENT, RESULTAT)
! 410:
! 411: implicit none
! 412:
! 413: complex*16 ARGUMENT
! 414: complex*16 RESULTAT
! 415:
! 416: RESULTAT = 10 ** ARGUMENT
! 417: return
! 418: end
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to bibliotheque_logarithmique.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src