Annotation of rpl/src/bibliotheque_trigonometrique.f, revision 1.1
1.1 ! bertrand 1: C===============================================================================
! 2: C RPL/2 (R) version 4.0.9
! 3: C Copyright (C) 1989-2010 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
CVSweb interface <joel.bertrand@systella.fr>