1: C===============================================================================
2: C RPL/2 (R) version 4.1.36
3: C Copyright (C) 1989-2024 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 logarithmiques diverses
23: C===============================================================================
24:
25: C-------------------------------------------------------------------------------
26: C Logarithme naturel
27: C-------------------------------------------------------------------------------
28:
29: subroutine F77LNIP(ARGUMENT, RESULTAT, ERREUR)
30:
31: implicit none
32:
33: integer*4 ERREUR
34:
35: integer*8 ARGUMENT
36:
37: real*8 RESULTAT
38:
39: if (ARGUMENT.ne.0) then
40: RESULTAT = log(dble(ARGUMENT))
41: ERREUR = 0
42: else
43: RESULTAT = 0
44: ERREUR = -1
45: end if
46: return
47: end
48:
49: subroutine F77LNIN(ARGUMENT, RESULTAT, ERREUR)
50:
51: implicit none
52:
53: complex*16 RESULTAT
54:
55: integer*4 ERREUR
56:
57: integer*8 ARGUMENT
58:
59: if (ARGUMENT.ne.0) then
60: RESULTAT = log(dble(ARGUMENT) + (0,0))
61: ERREUR = 0
62: else
63: RESULTAT = 0
64: ERREUR = -1
65: end if
66: return
67: end
68:
69: subroutine F77LNRP(ARGUMENT, RESULTAT, ERREUR)
70:
71: implicit none
72:
73: integer*4 ERREUR
74:
75: real*8 ARGUMENT
76: real*8 RESULTAT
77:
78: if (ARGUMENT.ne.0) then
79: RESULTAT = log(ARGUMENT)
80: ERREUR = 0
81: else
82: RESULTAT = 0
83: ERREUR = -1
84: end if
85: return
86: end
87:
88: subroutine F77LNRN(ARGUMENT, RESULTAT, ERREUR)
89:
90: implicit none
91:
92: complex*16 RESULTAT
93:
94: integer*4 ERREUR
95:
96: real*8 ARGUMENT
97:
98: if (ARGUMENT.ne.0) then
99: RESULTAT = log(ARGUMENT + (0,0))
100: ERREUR = 0
101: else
102: RESULTAT = 0
103: ERREUR = -1
104: end if
105: return
106: end
107:
108: subroutine F77LNC(ARGUMENT, RESULTAT, ERREUR)
109:
110: implicit none
111:
112: complex*16 ARGUMENT
113: complex*16 RESULTAT
114:
115: integer*4 ERREUR
116:
117: if (ARGUMENT.ne.0) then
118: RESULTAT = log(ARGUMENT)
119: ERREUR = 0
120: else
121: RESULTAT = 0
122: ERREUR = -1
123: end if
124: return
125: end
126:
127: C-------------------------------------------------------------------------------
128: C Logarithme vulgaire
129: C-------------------------------------------------------------------------------
130:
131: subroutine F77LOGIP(ARGUMENT, RESULTAT, ERREUR)
132:
133: implicit none
134:
135: integer*4 ERREUR
136:
137: integer*8 ARGUMENT
138:
139: real*8 RESULTAT
140:
141: if (ARGUMENT.ne.0) then
142: RESULTAT = log(dble(ARGUMENT)) / log(1D1)
143: ERREUR = 0
144: else
145: RESULTAT = 0
146: ERREUR = -1
147: end if
148: return
149: end
150:
151: subroutine F77LOGIN(ARGUMENT, RESULTAT, ERREUR)
152:
153: implicit none
154:
155: complex*16 RESULTAT
156:
157: integer*4 ERREUR
158:
159: integer*8 ARGUMENT
160:
161: if (ARGUMENT.ne.0) then
162: RESULTAT = log(dble(ARGUMENT) + (0,0)) / log(1D1)
163: ERREUR = 0
164: else
165: RESULTAT = 0
166: ERREUR = -1
167: end if
168: return
169: end
170:
171: subroutine F77LOGRP(ARGUMENT, RESULTAT, ERREUR)
172:
173: implicit none
174:
175: integer*4 ERREUR
176:
177: real*8 ARGUMENT
178: real*8 RESULTAT
179:
180: if (ARGUMENT.ne.0) then
181: RESULTAT = log(ARGUMENT) / log(1D1)
182: ERREUR = 0
183: else
184: RESULTAT = 0
185: ERREUR = -1
186: end if
187: return
188: end
189:
190: subroutine F77LOGRN(ARGUMENT, RESULTAT, ERREUR)
191:
192: implicit none
193:
194: complex*16 RESULTAT
195: integer*4 ERREUR
196:
197: real*8 ARGUMENT
198:
199: if (ARGUMENT.ne.0) then
200: RESULTAT = log(ARGUMENT + (0,0)) / log(1D1)
201: ERREUR = 0
202: else
203: RESULTAT = 0
204: ERREUR = -1
205: end if
206: return
207: end
208:
209: subroutine F77LOGC(ARGUMENT, RESULTAT, ERREUR)
210:
211: implicit none
212:
213: complex*16 ARGUMENT
214: complex*16 RESULTAT
215:
216: integer*4 ERREUR
217:
218: if (ARGUMENT.ne.0) then
219: RESULTAT = log(ARGUMENT) / log(1D1)
220: ERREUR = 0
221: else
222: RESULTAT = 0
223: ERREUR = -1
224: end if
225: return
226: end
227:
228: C-------------------------------------------------------------------------------
229: C Sinus hyperbolique
230: C-------------------------------------------------------------------------------
231:
232: subroutine F77SINH(ARGUMENT, RESULTAT)
233:
234: implicit none
235:
236: complex*16 ARGUMENT
237: complex*16 RESULTAT
238:
239: RESULTAT = (exp(ARGUMENT) - exp(-ARGUMENT)) / 2
240: return
241: end
242:
243: subroutine F77ASINHC(ARGUMENT, RESULTAT)
244:
245: implicit none
246:
247: complex*16 ARGUMENT
248: complex*16 RESULTAT
249:
250: RESULTAT = log(ARGUMENT + sqrt((ARGUMENT ** 2) + 1))
251: return
252: end
253:
254: subroutine F77ASINHI(ARGUMENT, RESULTAT)
255:
256: implicit none
257:
258: integer*8 ARGUMENT
259: real*8 RESULTAT
260:
261: RESULTAT = log(ARGUMENT + sqrt((dble(ARGUMENT) ** 2) + 1))
262: return
263: end
264:
265: subroutine F77ASINHR(ARGUMENT, RESULTAT)
266:
267: implicit none
268:
269: real*8 ARGUMENT
270: real*8 RESULTAT
271:
272: RESULTAT = log(ARGUMENT + sqrt((dble(ARGUMENT) ** 2) + 1))
273: return
274: end
275:
276: C-------------------------------------------------------------------------------
277: C Cosinus hyperbolique
278: C-------------------------------------------------------------------------------
279:
280: subroutine F77COSH(ARGUMENT, RESULTAT)
281:
282: implicit none
283:
284: complex*16 ARGUMENT
285: complex*16 RESULTAT
286:
287: RESULTAT = (exp(ARGUMENT) + exp(-ARGUMENT)) / 2
288: return
289: end
290:
291: subroutine F77ACOSHC(ARGUMENT, RESULTAT)
292:
293: implicit none
294:
295: complex*16 ARGUMENT
296: complex*16 RESULTAT
297:
298: RESULTAT = log(ARGUMENT + sqrt((ARGUMENT ** 2) - 1))
299: return
300: end
301:
302: subroutine F77ACOSHI(ARGUMENT, RESULTAT)
303:
304: implicit none
305:
306: integer*8 ARGUMENT
307: real*8 RESULTAT
308:
309: RESULTAT = log(ARGUMENT + sqrt((dble(ARGUMENT) ** 2) - 1))
310: return
311: end
312:
313: subroutine F77ACOSHR(ARGUMENT, RESULTAT)
314:
315: implicit none
316:
317: real*8 ARGUMENT
318: real*8 RESULTAT
319:
320: RESULTAT = log(ARGUMENT + sqrt((dble(ARGUMENT) ** 2) - 1))
321: return
322: end
323:
324: C-------------------------------------------------------------------------------
325: C Tangente hyperbolique
326: C-------------------------------------------------------------------------------
327:
328: subroutine F77TANH(ARGUMENT, RESULTAT, ERREUR)
329:
330: implicit none
331:
332: complex*16 ARGUMENT
333: complex*16 COSINUSH
334: complex*16 RESULTAT
335: complex*16 SINUSH
336:
337: integer*4 ERREUR
338:
339: ERREUR = 0
340:
341: if (dimag(ARGUMENT).eq.0) then
342: RESULTAT = dtan(dble(ARGUMENT))
343: else
344: call F77COSH(ARGUMENT, COSINUSH)
345:
346: if (COSINUSH.ne.0) then
347: call F77SINH(ARGUMENT, SINUSH)
348: RESULTAT = SINUSH / COSINUSH
349: else
350: RESULTAT = 0
351: ERREUR = -1
352: end if
353: end if
354: return
355: end
356:
357: subroutine F77ATANHC(ARGUMENT, RESULTAT)
358:
359: implicit none
360:
361: complex*16 ARGUMENT
362: complex*16 RESULTAT
363:
364: RESULTAT = log((1 + ARGUMENT) / (1 - ARGUMENT)) / 2
365: return
366: end
367:
368: subroutine F77ATANHI(ARGUMENT, RESULTAT)
369:
370: implicit none
371:
372: integer*8 ARGUMENT
373: real*8 RESULTAT
374:
375: RESULTAT = log((1 + dble(ARGUMENT)) / (1 - dble(ARGUMENT))) / 2
376: return
377: end
378:
379: subroutine F77ATANHR(ARGUMENT, RESULTAT)
380:
381: implicit none
382:
383: real*8 ARGUMENT
384: real*8 RESULTAT
385:
386: RESULTAT = log((1 + ARGUMENT) / (1 - ARGUMENT)) / 2
387: return
388: end
389:
390: C-------------------------------------------------------------------------------
391: C Exponentielle complexe
392: C-------------------------------------------------------------------------------
393:
394: subroutine F77EXPC(ARGUMENT, RESULTAT)
395:
396: implicit none
397:
398: complex*16 ARGUMENT
399: complex*16 RESULTAT
400:
401: RESULTAT = exp(ARGUMENT)
402: return
403: end
404:
405: C-------------------------------------------------------------------------------
406: C Alog complexe
407: C-------------------------------------------------------------------------------
408:
409: subroutine F77ALOGC(ARGUMENT, RESULTAT)
410:
411: implicit none
412:
413: complex*16 ARGUMENT
414: complex*16 RESULTAT
415:
416: RESULTAT = 10 ** ARGUMENT
417: return
418: end
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to bibliotheque_logarithmique.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src