![[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.48 ! bertrand 2: C RPL/2 (R) version 4.1.18
1.47 bertrand 3: C Copyright (C) 1989-2014 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:
1.38 bertrand 331: subroutine F77PUISSANCERI(RA, IB, RESULTAT)
1.1 bertrand 332:
333: implicit none
334:
335: integer*8 IB
336:
337: real*8 RA
338: real*8 RESULTAT
339:
1.38 bertrand 340: RESULTAT = RA ** IB
1.1 bertrand 341:
342: return
343: end
344:
345:
346: subroutine F77PUISSANCERR(RA, RB, RESULTAT)
347:
348: implicit none
349:
350: real*8 RA
351: real*8 RB
352: real*8 RESULTAT
353:
354: RESULTAT = RA ** RB
355:
356: return
357: end
358:
359:
360: subroutine F77PUISSANCERC(RA, CB, RESULTAT)
361:
362: implicit none
363:
364: complex*16 CB
365: complex*16 RESULTAT
366:
367: real*8 RA
368:
369: RESULTAT = RA ** CB
370:
371: return
372: end
373:
374:
1.38 bertrand 375: subroutine F77PUISSANCECI(CA, IB, RESULTAT)
1.1 bertrand 376:
377: implicit none
378:
379: complex*16 CA
380: complex*16 RESULTAT
381:
382: integer*8 IB
383:
1.38 bertrand 384: RESULTAT = CA ** IB
1.1 bertrand 385:
386: return
387: end
388:
389:
390: subroutine F77PUISSANCECR(CA, RB, RESULTAT)
391:
392: implicit none
393:
394: complex*16 CA
395: complex*16 RESULTAT
396:
397: real*8 RB
398:
399: RESULTAT = CA ** RB
400:
401: return
402: end
403:
404:
405: subroutine F77PUISSANCECC(CA, CB, RESULTAT)
406:
407: implicit none
408:
409: complex*16 CA
410: complex*16 CB
411: complex*16 RESULTAT
412:
413: RESULTAT = CA ** CB
414:
415: return
416: end
417:
418: C-- Racine carrée --------------------------------------------------------------
419:
420: subroutine F77RACINECARREEIP(IA, RESULTAT)
421:
422: implicit none
423:
424: integer*8 IA
425:
426: real*8 RA
427: real*8 RESULTAT
428:
429: RA = dble(IA)
430: RESULTAT = sqrt(RA)
431:
432: return
433: end
434:
435:
436: subroutine F77RACINECARREEIN(IA, RESULTAT)
437:
438: implicit none
439:
440: complex*16 CA
441: complex*16 RESULTAT
442:
443: integer*8 IA
444:
445: CA = dcmplx(IA)
446: RESULTAT = sqrt(CA)
447:
448: return
449: end
450:
451:
452: subroutine F77RACINECARREERP(RA, RESULTAT)
453:
454: implicit none
455:
456: real*8 RA
457: real*8 RESULTAT
458:
459: RESULTAT = sqrt(RA)
460:
461: return
462: end
463:
464:
465: subroutine F77RACINECARREERN(RA, RESULTAT)
466:
467: implicit none
468:
469: complex*16 CA
470: complex*16 RESULTAT
471:
472: real*8 RA
473:
474: CA = dcmplx(RA)
475: RESULTAT = sqrt(CA)
476:
477: return
478: end
479:
480:
481: subroutine F77RACINECARREEC(CA, RESULTAT)
482:
483: implicit none
484:
485: complex*16 CA
486: complex*16 RESULTAT
487:
488: RESULTAT = sqrt(CA)
489:
490: return
491: end
492:
493: C-- Valeur absolue -------------------------------------------------------------
494:
495: subroutine F77ABSC(C, RESULTAT)
496:
497: implicit none
498:
499: complex*16 C
500:
501: real*8 RESULTAT
502:
503: RESULTAT = ABS(C)
504:
505: return
506: end