Return to bibliotheque_trigonometrique.f CVS log

Up to [local] / rpl / src

Mise à jour du copyright.

    1: C===============================================================================
    2: C RPL/2 (R) version 4.1.36
    3: C Copyright (C) 1989-2025 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