Return to arithmetique.f CVS log

Up to [local] / rpl / src

Correction d'une réinitialisation sauvage de la pile des variables par niveau
dans la copie de la structure de description du processus. Cela corrige
la fonction SPAWN qui échouait sur un segmentation fault car la pile des
variables par niveau était vide alors même que l'arbre des variables contenait
bien les variables. Passage à la prerelease 2.

    1: C===============================================================================
    2: C RPL/2 (R) version 4.1.0.prerelease.2
    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