Return to bibliotheque_trigonometrique.f CVS log

Up to [local] / rpl / src

Merge entre la branche 4_0 et HEAD.

    1: C===============================================================================
    2: C RPL/2 (R) version 4.1.0.prerelease.0
    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: <<<<<<< bibliotheque_trigonometrique.f
   20: C RPL/2 (R) version 4.1.0.prerelease.0
   21: =======
   22: C RPL/2 (R) version 4.0.23
   23: >>>>>>> 1.15.2.2
   24: C Copyright (C) 1989-2011 Dr. BERTRAND Joël
   25: C
   26: C This file is part of RPL/2.
   27: C
   28: C RPL/2 is free software; you can redistribute it and/or modify it
   29: C under the terms of the CeCILL V2 License as published by the french
   30: C CEA, CNRS and INRIA.
   31: C
   32: C RPL/2 is distributed in the hope that it will be useful, but WITHOUT
   33: C ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
   34: C FITNESS FOR A PARTICULAR PURPOSE.  See the CeCILL V2 License
   35: C for more details.
   36: C
   37: C You should have received a copy of the CeCILL License
   38: C along with RPL/2. If not, write to info@cecill.info.
   39: C===============================================================================
   40: 
   41: 
   42: C===============================================================================
   43: C  Fonctions trigonometriques diverses
   44: C===============================================================================
   45: 
   46: C-------------------------------------------------------------------------------
   47: C  Sinus (argument en radians)
   48: C-------------------------------------------------------------------------------
   49: 
   50:       subroutine F77SIN(ARGUMENT, RESULTAT)
   51: 
   52:       implicit none
   53: 
   54:       complex*16    ARGUMENT
   55:       complex*16    RESULTAT
   56: 
   57:       RESULTAT = sin(ARGUMENT)
   58:       return
   59:       end
   60: 
   61: C-------------------------------------------------------------------------------
   62: C  Arcsin (argument en radians)
   63: C-------------------------------------------------------------------------------
   64: 
   65:       subroutine F77ASIN(ARGUMENT, RESULTAT)
   66: 
   67:       implicit none
   68: 
   69:       complex*16    ARGUMENT
   70:       complex*16    RESULTAT
   71: 
   72:       RESULTAT = (0,-1) * log(((0,1) * ARGUMENT) + sqrt(1 -
   73:      +        (ARGUMENT ** 2)))
   74:       return
   75:       end
   76: 
   77: C-------------------------------------------------------------------------------
   78: C  Cosinus (argument en radians)
   79: C-------------------------------------------------------------------------------
   80: 
   81:       subroutine F77COS(ARGUMENT, RESULTAT)
   82: 
   83:       implicit none
   84: 
   85:       complex*16    ARGUMENT
   86:       complex*16    RESULTAT
   87: 
   88:       RESULTAT = cos(ARGUMENT)
   89:       return
   90:       end
   91: 
   92: C-------------------------------------------------------------------------------
   93: C  Arccos (argument en radians)
   94: C-------------------------------------------------------------------------------
   95: 
   96:       subroutine F77ACOS(ARGUMENT, RESULTAT)
   97: 
   98:       implicit none
   99: 
  100:       complex*16    ARGUMENT
  101:       complex*16    RESULTAT
  102: 
  103:       RESULTAT = (0,-1) * log(ARGUMENT + sqrt((ARGUMENT ** 2) - 1))
  104:       return
  105:       end
  106: 
  107: C-------------------------------------------------------------------------------
  108: C  Tangente (argument en radians)
  109: C-------------------------------------------------------------------------------
  110: 
  111:       subroutine F77TAN(ARGUMENT, RESULTAT, ERREUR)
  112: 
  113:       implicit none
  114: 
  115:       complex*16    ARGUMENT
  116:       complex*16    COSINUS
  117:       complex*16    RESULTAT
  118: 
  119:       integer*4     ERREUR
  120: 
  121:       ERREUR = 0
  122: 
  123:       if (dimag(ARGUMENT).eq.0) then
  124:           RESULTAT = dtan(dble(ARGUMENT))
  125:       else
  126:           COSINUS = cos(ARGUMENT)
  127: 
  128:           if (COSINUS.ne.0) then
  129:               RESULTAT = sin(ARGUMENT) / COSINUS
  130:           else
  131:               RESULTAT = 0
  132:               ERREUR = -1
  133:           end if
  134:       end if
  135:       return
  136:       end
  137: 
  138: C-------------------------------------------------------------------------------
  139: C  Arctg (argument en radians)
  140: C-------------------------------------------------------------------------------
  141: 
  142:       subroutine F77ATAN(ARGUMENT, RESULTAT, ERREUR)
  143: 
  144:       implicit none
  145: 
  146:       complex*16    ARGUMENT
  147:       complex*16    RESULTAT
  148: 
  149:       integer*4     ERREUR
  150: 
  151:       ERREUR = 0
  152: 
  153:       if ((ARGUMENT.ne.(0,1)).and.(ARGUMENT.ne.(0,-1))) then
  154:           RESULTAT = (0,.5) * log(((0,1) + ARGUMENT) /
  155:      +            ((0,1) - ARGUMENT))
  156:       else
  157:           RESULTAT = 0
  158:           ERREUR = -1
  159:       end if
  160:       return
  161:       end