Annotation of rpl/src/bibliotheque_trigonometrique.f, revision 1.18
1.1 bertrand 1: C===============================================================================
1.16 bertrand 2: C RPL/2 (R) version 4.1.0.prerelease.0
1.14 bertrand 3: C Copyright (C) 1989-2011 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===============================================================================
1.17 bertrand 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===============================================================================
1.1 bertrand 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
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to bibliotheque_trigonometrique.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src