![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to arithmetique.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src|
Return to arithmetique.f CVS log | Up to [local] / rpl / src |
1.1 bertrand 1: C===============================================================================
1.35 ! bertrand 2: C RPL/2 (R) version 4.1.9
1.31 bertrand 3: C Copyright (C) 1989-2012 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-- Addition -------------------------------------------------------------------
22:
23: subroutine F77ADDITIONCI(CA, IB, RESULTAT)
24:
25: implicit none
26:
27: complex*16 CA
28: complex*16 CB
29: complex*16 RESULTAT
30:
31: integer*8 IB
32:
33: CB = dcmplx(IB)
34: RESULTAT = CA + CB
35:
36: return
37: end
38:
39:
40: subroutine F77ADDITIONCC(CA, CB, RESULTAT)
41:
42: implicit none
43:
44: complex*16 CA
45: complex*16 CB
46: complex*16 RESULTAT
47:
48: RESULTAT = CA + CB
49:
50: return
51: end
52:
53:
54: subroutine F77ADDITIONCR(CA, RB, RESULTAT)
55:
56: implicit none
57:
58: complex*16 CA
59: complex*16 CB
60: complex*16 RESULTAT
61:
62: real*8 RB
63:
64: CB = dcmplx(RB)
65: RESULTAT = CA + CB
66:
67: return
68: end
69:
70: C-- Multiplication -------------------------------------------------------------
71:
72: subroutine F77MULTIPLICATIONCI(CA, IB, RESULTAT)
73:
74: implicit none
75:
76: complex*16 CA
77: complex*16 CB
78: complex*16 RESULTAT
79:
80: integer*8 IB
81:
82: CB = dcmplx(IB)
83: RESULTAT = CA * CB
84:
85: return
86: end
87:
88:
89: subroutine F77MULTIPLICATIONCC(CA, CB, RESULTAT)
90:
91: implicit none
92:
93: complex*16 CA
94: complex*16 CB
95: complex*16 RESULTAT
96:
97: RESULTAT = CA * CB
98:
99: return
100: end
101:
102:
103: subroutine F77MULTIPLICATIONCR(CA, RB, RESULTAT)
104:
105: implicit none
106:
107: complex*16 CA
108: complex*16 CB
109: complex*16 RESULTAT
110:
111: real*8 RB
112:
113: CB = dcmplx(RB)
114: RESULTAT = CA * CB
115:
116: return
117: end
118:
119: C-- Soustraction ---------------------------------------------------------------
120:
121: subroutine F77SOUSTRACTIONCI(CA, IB, RESULTAT)
122:
123: implicit none
124:
125: complex*16 CA
126: complex*16 CB
127: complex*16 RESULTAT
128:
129: integer*8 IB
130:
131: CB = dcmplx(IB)
132: RESULTAT = CA - CB
133:
134: return
135: end
136:
137:
138: subroutine F77SOUSTRACTIONIC(IA, CB, RESULTAT)
139:
140: implicit none
141:
142: complex*16 CA
143: complex*16 CB
144: complex*16 RESULTAT
145:
146: integer*8 IA
147:
148: CA = dcmplx(IA)
149: RESULTAT = CA - CB
150:
151: return
152: end
153:
154:
155: subroutine F77SOUSTRACTIONCC(CA, CB, RESULTAT)
156:
157: implicit none
158:
159: complex*16 CA
160: complex*16 CB
161: complex*16 RESULTAT
162:
163: RESULTAT = CA - CB
164:
165: return
166: end
167:
168:
169: subroutine F77SOUSTRACTIONCR(CA, RB, RESULTAT)
170:
171: implicit none
172:
173: complex*16 CA
174: complex*16 CB
175: complex*16 RESULTAT
176:
177: real*8 RB
178:
179: CB = dcmplx(RB)
180: RESULTAT = CA - CB
181:
182: return
183: end
184:
185:
186: subroutine F77SOUSTRACTIONRC(RA, CB, RESULTAT)
187:
188: implicit none
189:
190: complex*16 CA
191: complex*16 CB
192: complex*16 RESULTAT
193:
194: real*8 RA
195:
196: CA = dcmplx(RA)
197: RESULTAT = CA - CB
198:
199: return
200: end
201:
202: C-- Division -------------------------------------------------------------------
203:
204: subroutine F77DIVISIONCI(CA, IB, RESULTAT)
205:
206: implicit none
207:
208: complex*16 CA
209: complex*16 CB
210: complex*16 RESULTAT
211:
212: integer*8 IB
213:
214: CB = dcmplx(IB)
215: RESULTAT = CA / CB
216:
217: return
218: end
219:
220:
221: subroutine F77DIVISIONIC(IA, CB, RESULTAT)
222:
223: implicit none
224:
225: complex*16 CA
226: complex*16 CB
227: complex*16 RESULTAT
228:
229: integer*8 IA
230:
231: CA = dcmplx(IA)
232: RESULTAT = CA / CB
233:
234: return
235: end
236:
237:
238: subroutine F77DIVISIONCC(CA, CB, RESULTAT)
239:
240: implicit none
241:
242: complex*16 CA
243: complex*16 CB
244: complex*16 RESULTAT
245:
246: RESULTAT = CA / CB
247:
248: return
249: end
250:
251:
252: subroutine F77DIVISIONCR(CA, RB, RESULTAT)
253:
254: implicit none
255:
256: complex*16 CA
257: complex*16 CB
258: complex*16 RESULTAT
259:
260: real*8 RB
261:
262: CB = dcmplx(RB)
263: RESULTAT = CA / CB
264:
265: return
266: end
267:
268:
269: subroutine F77DIVISIONRC(RA, CB, RESULTAT)
270:
271: implicit none
272:
273: complex*16 CA
274: complex*16 CB
275: complex*16 RESULTAT
276:
277: real*8 RA
278:
279: CA = dcmplx(RA)
280: RESULTAT = CA / CB
281:
282: return
283: end
284:
285: C-- Puissance ------------------------------------------------------------------
286:
287: subroutine F77PUISSANCEII(IA, IB, RESULTAT)
288:
289: implicit none
290:
291: integer*8 IA
292: integer*8 IB
293: integer*8 RESULTAT
294:
295: RESULTAT = IA ** IB
296:
297: return
298: end
299:
300:
301: subroutine F77PUISSANCEIR(IA, RB, RESULTAT)
302:
303: implicit none
304:
305: integer*8 IA
306:
307: real*8 RB
308: real*8 RESULTAT
309:
310: RESULTAT = IA ** RB
311:
312: return
313: end
314:
315:
316: subroutine F77PUISSANCEIC(IA, CB, RESULTAT)
317:
318: implicit none
319:
320: complex*16 CB
321: complex*16 RESULTAT
322:
323: integer*8 IA
324:
325: RESULTAT = IA ** CB
326:
327: return
328: end
329:
330:
331: subroutine F77PUISSANCERI(RA, IB, RESULTAT, TRONCATURE)
332:
333: implicit none
334:
335: integer*4 INTEGER4
336: integer*4 TRONCATURE
337:
338: integer*8 IB
339:
340: real*8 RA
341: real*8 RESULTAT
342:
343: C-- IB converti en integer*4
344: INTEGER4 = IB
345:
346: if (IB.ne.INTEGER4) then
347: TRONCATURE = -1
348: else
349: TRONCATURE = 0
350: end if
351:
352: RESULTAT = RA ** INTEGER4
353:
354: return
355: end
356:
357:
358: subroutine F77PUISSANCERR(RA, RB, RESULTAT)
359:
360: implicit none
361:
362: real*8 RA
363: real*8 RB
364: real*8 RESULTAT
365:
366: RESULTAT = RA ** RB
367:
368: return
369: end
370:
371:
372: subroutine F77PUISSANCERC(RA, CB, RESULTAT)
373:
374: implicit none
375:
376: complex*16 CB
377: complex*16 RESULTAT
378:
379: real*8 RA
380:
381: RESULTAT = RA ** CB
382:
383: return
384: end
385:
386:
387: subroutine F77PUISSANCECI(CA, IB, RESULTAT, TRONCATURE)
388:
389: implicit none
390:
391: complex*16 CA
392: complex*16 RESULTAT
393:
394: integer*4 INTEGER4
395: integer*4 TRONCATURE
396:
397: integer*8 IB
398:
399: C-- IB converti en integer*4
400: INTEGER4 = IB
401:
402: if (IB.ne.INTEGER4) then
403: TRONCATURE = -1
404: else
405: TRONCATURE = 0
406: end if
407:
408: RESULTAT = CA ** INTEGER4
409:
410: return
411: end
412:
413:
414: subroutine F77PUISSANCECR(CA, RB, RESULTAT)
415:
416: implicit none
417:
418: complex*16 CA
419: complex*16 RESULTAT
420:
421: real*8 RB
422:
423: RESULTAT = CA ** RB
424:
425: return
426: end
427:
428:
429: subroutine F77PUISSANCECC(CA, CB, RESULTAT)
430:
431: implicit none
432:
433: complex*16 CA
434: complex*16 CB
435: complex*16 RESULTAT
436:
437: RESULTAT = CA ** CB
438:
439: return
440: end
441:
442: C-- Racine carrée --------------------------------------------------------------
443:
444: subroutine F77RACINECARREEIP(IA, RESULTAT)
445:
446: implicit none
447:
448: integer*8 IA
449:
450: real*8 RA
451: real*8 RESULTAT
452:
453: RA = dble(IA)
454: RESULTAT = sqrt(RA)
455:
456: return
457: end
458:
459:
460: subroutine F77RACINECARREEIN(IA, RESULTAT)
461:
462: implicit none
463:
464: complex*16 CA
465: complex*16 RESULTAT
466:
467: integer*8 IA
468:
469: CA = dcmplx(IA)
470: RESULTAT = sqrt(CA)
471:
472: return
473: end
474:
475:
476: subroutine F77RACINECARREERP(RA, RESULTAT)
477:
478: implicit none
479:
480: real*8 RA
481: real*8 RESULTAT
482:
483: RESULTAT = sqrt(RA)
484:
485: return
486: end
487:
488:
489: subroutine F77RACINECARREERN(RA, RESULTAT)
490:
491: implicit none
492:
493: complex*16 CA
494: complex*16 RESULTAT
495:
496: real*8 RA
497:
498: CA = dcmplx(RA)
499: RESULTAT = sqrt(CA)
500:
501: return
502: end
503:
504:
505: subroutine F77RACINECARREEC(CA, RESULTAT)
506:
507: implicit none
508:
509: complex*16 CA
510: complex*16 RESULTAT
511:
512: RESULTAT = sqrt(CA)
513:
514: return
515: end
516:
517: C-- Valeur absolue -------------------------------------------------------------
518:
519: subroutine F77ABSC(C, RESULTAT)
520:
521: implicit none
522:
523: complex*16 C
524:
525: real*8 RESULTAT
526:
527: RESULTAT = ABS(C)
528:
529: return
530: end