Return to bibliotheque_trigonometrique.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===============================================================================
   22: C  Fonctions trigonometriques diverses
   23: C===============================================================================
   24: 
   25: C-------------------------------------------------------------------------------
   26: C  Sinus (argument en radians)
   27: C-------------------------------------------------------------------------------
   28: 
   29:       subroutine F77SIN(ARGUMENT, RESULTAT)
   30: 
   31:       implicit none
   32: 
   33:       complex*16    ARGUMENT
   34:       complex*16    RESULTAT
   35: 
   36:       RESULTAT = sin(ARGUMENT)
   37:       return
   38:       end
   39: 
   40: C-------------------------------------------------------------------------------
   41: C  Arcsin (argument en radians)
   42: C-------------------------------------------------------------------------------
   43: 
   44:       subroutine F77ASIN(ARGUMENT, RESULTAT)
   45: 
   46:       implicit none
   47: 
   48:       complex*16    ARGUMENT
   49:       complex*16    RESULTAT
   50: 
   51:       RESULTAT = (0,-1) * log(((0,1) * ARGUMENT) + sqrt(1 -
   52:      +        (ARGUMENT ** 2)))
   53:       return
   54:       end
   55: 
   56: C-------------------------------------------------------------------------------
   57: C  Cosinus (argument en radians)
   58: C-------------------------------------------------------------------------------
   59: 
   60:       subroutine F77COS(ARGUMENT, RESULTAT)
   61: 
   62:       implicit none
   63: 
   64:       complex*16    ARGUMENT
   65:       complex*16    RESULTAT
   66: 
   67:       RESULTAT = cos(ARGUMENT)
   68:       return
   69:       end
   70: 
   71: C-------------------------------------------------------------------------------
   72: C  Arccos (argument en radians)
   73: C-------------------------------------------------------------------------------
   74: 
   75:       subroutine F77ACOS(ARGUMENT, RESULTAT)
   76: 
   77:       implicit none
   78: 
   79:       complex*16    ARGUMENT
   80:       complex*16    RESULTAT
   81: 
   82:       RESULTAT = (0,-1) * log(ARGUMENT + sqrt((ARGUMENT ** 2) - 1))
   83:       return
   84:       end
   85: 
   86: C-------------------------------------------------------------------------------
   87: C  Tangente (argument en radians)
   88: C-------------------------------------------------------------------------------
   89: 
   90:       subroutine F77TAN(ARGUMENT, RESULTAT, ERREUR)
   91: 
   92:       implicit none
   93: 
   94:       complex*16    ARGUMENT
   95:       complex*16    COSINUS
   96:       complex*16    RESULTAT
   97: 
   98:       integer*4     ERREUR
   99: 
  100:       ERREUR = 0
  101: 
  102:       if (dimag(ARGUMENT).eq.0) then
  103:           RESULTAT = dtan(dble(ARGUMENT))
  104:       else
  105:           COSINUS = cos(ARGUMENT)
  106: 
  107:           if (COSINUS.ne.0) then
  108:               RESULTAT = sin(ARGUMENT) / COSINUS
  109:           else
  110:               RESULTAT = 0
  111:               ERREUR = -1
  112:           end if
  113:       end if
  114:       return
  115:       end
  116: 
  117: C-------------------------------------------------------------------------------
  118: C  Arctg (argument en radians)
  119: C-------------------------------------------------------------------------------
  120: 
  121:       subroutine F77ATAN(ARGUMENT, RESULTAT, ERREUR)
  122: 
  123:       implicit none
  124: 
  125:       complex*16    ARGUMENT
  126:       complex*16    RESULTAT
  127: 
  128:       integer*4     ERREUR
  129: 
  130:       ERREUR = 0
  131: 
  132:       if ((ARGUMENT.ne.(0,1)).and.(ARGUMENT.ne.(0,-1))) then
  133:           RESULTAT = (0,.5) * log(((0,1) + ARGUMENT) /
  134:      +            ((0,1) - ARGUMENT))
  135:       else
  136:           RESULTAT = 0
  137:           ERREUR = -1
  138:       end if
  139:       return
  140:       end