File:  [local] / rpl / src / arithmetique.f
Revision 1.49: download - view: text, annotated - select for diffs - revision graph
Thu Jul 17 08:07:15 2014 UTC (9 years, 9 months ago) by bertrand
Branches: MAIN
CVS tags: HEAD
En route pour la 4.1.19.

    1: C===============================================================================
    2: C RPL/2 (R) version 4.1.19
    3: C Copyright (C) 1989-2014 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)
  332: 
  333:       implicit none
  334: 
  335:       integer*8         IB
  336: 
  337:       real*8            RA
  338:       real*8            RESULTAT
  339: 
  340:       RESULTAT = RA ** IB
  341: 
  342:       return
  343:       end
  344: 
  345: 
  346:       subroutine F77PUISSANCERR(RA, RB, RESULTAT)
  347: 
  348:       implicit none
  349: 
  350:       real*8            RA
  351:       real*8            RB
  352:       real*8            RESULTAT
  353: 
  354:       RESULTAT = RA ** RB
  355: 
  356:       return
  357:       end
  358: 
  359: 
  360:       subroutine F77PUISSANCERC(RA, CB, RESULTAT)
  361: 
  362:       implicit none
  363: 
  364:       complex*16        CB
  365:       complex*16        RESULTAT
  366: 
  367:       real*8            RA
  368: 
  369:       RESULTAT = RA ** CB
  370: 
  371:       return
  372:       end
  373: 
  374: 
  375:       subroutine F77PUISSANCECI(CA, IB, RESULTAT)
  376: 
  377:       implicit none
  378: 
  379:       complex*16        CA
  380:       complex*16        RESULTAT
  381: 
  382:       integer*8         IB
  383: 
  384:       RESULTAT = CA ** IB
  385: 
  386:       return
  387:       end
  388: 
  389: 
  390:       subroutine F77PUISSANCECR(CA, RB, RESULTAT)
  391: 
  392:       implicit none
  393: 
  394:       complex*16        CA
  395:       complex*16        RESULTAT
  396: 
  397:       real*8            RB
  398: 
  399:       RESULTAT = CA ** RB
  400: 
  401:       return
  402:       end
  403: 
  404: 
  405:       subroutine F77PUISSANCECC(CA, CB, RESULTAT)
  406: 
  407:       implicit none
  408: 
  409:       complex*16        CA
  410:       complex*16        CB
  411:       complex*16        RESULTAT
  412: 
  413:       RESULTAT = CA ** CB
  414: 
  415:       return
  416:       end
  417: 
  418: C-- Racine carrée --------------------------------------------------------------
  419: 
  420:       subroutine F77RACINECARREEIP(IA, RESULTAT)
  421: 
  422:       implicit none
  423: 
  424:       integer*8         IA
  425: 
  426:       real*8            RA
  427:       real*8            RESULTAT
  428: 
  429:       RA = dble(IA)
  430:       RESULTAT = sqrt(RA)
  431: 
  432:       return
  433:       end
  434: 
  435: 
  436:       subroutine F77RACINECARREEIN(IA, RESULTAT)
  437: 
  438:       implicit none
  439: 
  440:       complex*16        CA
  441:       complex*16        RESULTAT
  442: 
  443:       integer*8         IA
  444: 
  445:       CA = dcmplx(IA)
  446:       RESULTAT = sqrt(CA)
  447: 
  448:       return
  449:       end
  450: 
  451: 
  452:       subroutine F77RACINECARREERP(RA, RESULTAT)
  453: 
  454:       implicit none
  455: 
  456:       real*8            RA
  457:       real*8            RESULTAT
  458: 
  459:       RESULTAT = sqrt(RA)
  460: 
  461:       return
  462:       end
  463: 
  464: 
  465:       subroutine F77RACINECARREERN(RA, RESULTAT)
  466: 
  467:       implicit none
  468: 
  469:       complex*16        CA
  470:       complex*16        RESULTAT
  471: 
  472:       real*8            RA
  473: 
  474:       CA = dcmplx(RA)
  475:       RESULTAT = sqrt(CA)
  476: 
  477:       return
  478:       end
  479: 
  480: 
  481:       subroutine F77RACINECARREEC(CA, RESULTAT)
  482: 
  483:       implicit none
  484: 
  485:       complex*16        CA
  486:       complex*16        RESULTAT
  487: 
  488:       RESULTAT = sqrt(CA)
  489: 
  490:       return
  491:       end
  492: 
  493: C-- Valeur absolue -------------------------------------------------------------
  494: 
  495:       subroutine F77ABSC(C, RESULTAT)
  496: 
  497:       implicit none
  498: 
  499:       complex*16        C
  500: 
  501:       real*8            RESULTAT
  502: 
  503:       RESULTAT = ABS(C)
  504: 
  505:       return
  506:       end

CVSweb interface <joel.bertrand@systella.fr>