Return to bibliotheque_trigonometrique.f CVS log

Up to [local] / rpl / src

Annotation of rpl/src/bibliotheque_trigonometrique.f, revision 1.65

1.1       bertrand    1: C===============================================================================
1.64      bertrand    2: C RPL/2 (R) version 4.1.32
1.65    ! bertrand    3: C Copyright (C) 1989-2020 Dr. BERTRAND Joël
1.1       bertrand    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