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