Annotation of rpl/src/bibliotheque_logarithmique.f, revision 1.41

1.1       bertrand    1: C===============================================================================
1.41    ! bertrand    2: C RPL/2 (R) version 4.1.13
1.40      bertrand    3: C Copyright (C) 1989-2013 Dr. BERTRAND Joël
1.1       bertrand    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>