OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [a-ngcoar.adb] - Blame information for rev 706

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 706 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                         GNAT COMPILER COMPONENTS                         --
4
--                                                                          --
5
--                   ADA.NUMERICS.GENERIC_COMPLEX_ARRAYS                    --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--            Copyright (C) 2006-2011, Free Software Foundation, Inc.       --
10
--                                                                          --
11
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
12
-- terms of the  GNU General Public License as published  by the Free Soft- --
13
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
14
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
15
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
16
-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
17
--                                                                          --
18
-- As a special exception under Section 7 of GPL version 3, you are granted --
19
-- additional permissions described in the GCC Runtime Library Exception,   --
20
-- version 3.1, as published by the Free Software Foundation.               --
21
--                                                                          --
22
-- You should have received a copy of the GNU General Public License and    --
23
-- a copy of the GCC Runtime Library Exception along with this program;     --
24
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
25
-- <http://www.gnu.org/licenses/>.                                          --
26
--                                                                          --
27
-- GNAT was originally developed  by the GNAT team at  New York University. --
28
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
29
--                                                                          --
30
------------------------------------------------------------------------------
31
 
32
with System.Generic_Array_Operations; use System.Generic_Array_Operations;
33
with Ada.Numerics; use Ada.Numerics;
34
 
35
package body Ada.Numerics.Generic_Complex_Arrays is
36
 
37
   --  Operations that are defined in terms of operations on the type Real,
38
   --  such as addition, subtraction and scaling, are computed in the canonical
39
   --  way looping over all elements.
40
 
41
   package Ops renames System.Generic_Array_Operations;
42
 
43
   subtype Real is Real_Arrays.Real;
44
   --  Work around visibility bug ???
45
 
46
   function Is_Non_Zero (X : Complex) return Boolean is (X /= (0.0, 0.0));
47
   --  Needed by Back_Substitute
48
 
49
   procedure Back_Substitute is new Ops.Back_Substitute
50
     (Scalar        => Complex,
51
      Matrix        => Complex_Matrix,
52
      Is_Non_Zero   => Is_Non_Zero);
53
 
54
   procedure Forward_Eliminate is new Ops.Forward_Eliminate
55
    (Scalar        => Complex,
56
     Real          => Real'Base,
57
     Matrix        => Complex_Matrix,
58
     Zero          => (0.0, 0.0),
59
     One           => (1.0, 0.0));
60
 
61
   procedure Transpose is new Ops.Transpose
62
                                (Scalar => Complex,
63
                                 Matrix => Complex_Matrix);
64
 
65
   --  Helper function that raises a Constraint_Error is the argument is
66
   --  not a square matrix, and otherwise returns its length.
67
 
68
   function Length is new Square_Matrix_Length (Complex, Complex_Matrix);
69
 
70
   --  Instant a generic square root implementation here, in order to avoid
71
   --  instantiating a complete copy of Generic_Elementary_Functions.
72
   --  Speed of the square root is not a big concern here.
73
 
74
   function Sqrt is new Ops.Sqrt (Real'Base);
75
 
76
   --  Instantiating the following subprograms directly would lead to
77
   --  name clashes, so use a local package.
78
 
79
   package Instantiations is
80
 
81
      ---------
82
      -- "*" --
83
      ---------
84
 
85
      function "*" is new Vector_Scalar_Elementwise_Operation
86
                            (Left_Scalar   => Complex,
87
                             Right_Scalar  => Complex,
88
                             Result_Scalar => Complex,
89
                             Left_Vector   => Complex_Vector,
90
                             Result_Vector => Complex_Vector,
91
                             Operation     => "*");
92
 
93
      function "*" is new Vector_Scalar_Elementwise_Operation
94
                            (Left_Scalar   => Complex,
95
                             Right_Scalar  => Real'Base,
96
                             Result_Scalar => Complex,
97
                             Left_Vector   => Complex_Vector,
98
                             Result_Vector => Complex_Vector,
99
                             Operation     => "*");
100
 
101
      function "*" is new Scalar_Vector_Elementwise_Operation
102
                            (Left_Scalar   => Complex,
103
                             Right_Scalar  => Complex,
104
                             Result_Scalar => Complex,
105
                             Right_Vector  => Complex_Vector,
106
                             Result_Vector => Complex_Vector,
107
                             Operation     => "*");
108
 
109
      function "*" is new Scalar_Vector_Elementwise_Operation
110
                            (Left_Scalar   => Real'Base,
111
                             Right_Scalar  => Complex,
112
                             Result_Scalar => Complex,
113
                             Right_Vector  => Complex_Vector,
114
                             Result_Vector => Complex_Vector,
115
                             Operation     => "*");
116
 
117
      function "*" is new Inner_Product
118
                            (Left_Scalar   => Complex,
119
                             Right_Scalar  => Real'Base,
120
                             Result_Scalar => Complex,
121
                             Left_Vector   => Complex_Vector,
122
                             Right_Vector  => Real_Vector,
123
                             Zero          => (0.0, 0.0));
124
 
125
      function "*" is new Inner_Product
126
                            (Left_Scalar   => Real'Base,
127
                             Right_Scalar  => Complex,
128
                             Result_Scalar => Complex,
129
                             Left_Vector   => Real_Vector,
130
                             Right_Vector  => Complex_Vector,
131
                             Zero          => (0.0, 0.0));
132
 
133
      function "*" is new Inner_Product
134
                            (Left_Scalar   => Complex,
135
                             Right_Scalar  => Complex,
136
                             Result_Scalar => Complex,
137
                             Left_Vector   => Complex_Vector,
138
                             Right_Vector  => Complex_Vector,
139
                             Zero          => (0.0, 0.0));
140
 
141
      function "*" is new Outer_Product
142
                            (Left_Scalar   => Complex,
143
                             Right_Scalar  => Complex,
144
                             Result_Scalar => Complex,
145
                             Left_Vector   => Complex_Vector,
146
                             Right_Vector  => Complex_Vector,
147
                             Matrix        => Complex_Matrix);
148
 
149
      function "*" is new Outer_Product
150
                            (Left_Scalar   => Real'Base,
151
                             Right_Scalar  => Complex,
152
                             Result_Scalar => Complex,
153
                             Left_Vector   => Real_Vector,
154
                             Right_Vector  => Complex_Vector,
155
                             Matrix        => Complex_Matrix);
156
 
157
      function "*" is new Outer_Product
158
                            (Left_Scalar   => Complex,
159
                             Right_Scalar  => Real'Base,
160
                             Result_Scalar => Complex,
161
                             Left_Vector   => Complex_Vector,
162
                             Right_Vector  => Real_Vector,
163
                             Matrix        => Complex_Matrix);
164
 
165
      function "*" is new Matrix_Scalar_Elementwise_Operation
166
                            (Left_Scalar   => Complex,
167
                             Right_Scalar  => Complex,
168
                             Result_Scalar => Complex,
169
                             Left_Matrix   => Complex_Matrix,
170
                             Result_Matrix => Complex_Matrix,
171
                             Operation     => "*");
172
 
173
      function "*" is new Matrix_Scalar_Elementwise_Operation
174
                            (Left_Scalar   => Complex,
175
                             Right_Scalar  => Real'Base,
176
                             Result_Scalar => Complex,
177
                             Left_Matrix   => Complex_Matrix,
178
                             Result_Matrix => Complex_Matrix,
179
                             Operation     => "*");
180
 
181
      function "*" is new Scalar_Matrix_Elementwise_Operation
182
                            (Left_Scalar   => Complex,
183
                             Right_Scalar  => Complex,
184
                             Result_Scalar => Complex,
185
                             Right_Matrix  => Complex_Matrix,
186
                             Result_Matrix => Complex_Matrix,
187
                             Operation     => "*");
188
 
189
      function "*" is new Scalar_Matrix_Elementwise_Operation
190
                            (Left_Scalar   => Real'Base,
191
                             Right_Scalar  => Complex,
192
                             Result_Scalar => Complex,
193
                             Right_Matrix  => Complex_Matrix,
194
                             Result_Matrix => Complex_Matrix,
195
                             Operation     => "*");
196
 
197
      function "*" is new Matrix_Vector_Product
198
                            (Left_Scalar   => Real'Base,
199
                             Right_Scalar  => Complex,
200
                             Result_Scalar => Complex,
201
                             Matrix        => Real_Matrix,
202
                             Right_Vector  => Complex_Vector,
203
                             Result_Vector => Complex_Vector,
204
                             Zero          => (0.0, 0.0));
205
 
206
      function "*" is new Matrix_Vector_Product
207
                            (Left_Scalar   => Complex,
208
                             Right_Scalar  => Real'Base,
209
                             Result_Scalar => Complex,
210
                             Matrix        => Complex_Matrix,
211
                             Right_Vector  => Real_Vector,
212
                             Result_Vector => Complex_Vector,
213
                             Zero          => (0.0, 0.0));
214
 
215
      function "*" is new Matrix_Vector_Product
216
                            (Left_Scalar   => Complex,
217
                             Right_Scalar  => Complex,
218
                             Result_Scalar => Complex,
219
                             Matrix        => Complex_Matrix,
220
                             Right_Vector  => Complex_Vector,
221
                             Result_Vector => Complex_Vector,
222
                             Zero          => (0.0, 0.0));
223
 
224
      function "*" is new Vector_Matrix_Product
225
                            (Left_Scalar   => Real'Base,
226
                             Right_Scalar  => Complex,
227
                             Result_Scalar => Complex,
228
                             Left_Vector   => Real_Vector,
229
                             Matrix        => Complex_Matrix,
230
                             Result_Vector => Complex_Vector,
231
                             Zero          => (0.0, 0.0));
232
 
233
      function "*" is new Vector_Matrix_Product
234
                            (Left_Scalar   => Complex,
235
                             Right_Scalar  => Real'Base,
236
                             Result_Scalar => Complex,
237
                             Left_Vector   => Complex_Vector,
238
                             Matrix        => Real_Matrix,
239
                             Result_Vector => Complex_Vector,
240
                             Zero          => (0.0, 0.0));
241
 
242
      function "*" is new Vector_Matrix_Product
243
                            (Left_Scalar   => Complex,
244
                             Right_Scalar  => Complex,
245
                             Result_Scalar => Complex,
246
                             Left_Vector   => Complex_Vector,
247
                             Matrix        => Complex_Matrix,
248
                             Result_Vector => Complex_Vector,
249
                             Zero          => (0.0, 0.0));
250
 
251
      function "*" is new Matrix_Matrix_Product
252
                            (Left_Scalar   => Complex,
253
                             Right_Scalar  => Complex,
254
                             Result_Scalar => Complex,
255
                             Left_Matrix   => Complex_Matrix,
256
                             Right_Matrix  => Complex_Matrix,
257
                             Result_Matrix => Complex_Matrix,
258
                             Zero          => (0.0, 0.0));
259
 
260
      function "*" is new Matrix_Matrix_Product
261
                            (Left_Scalar   => Real'Base,
262
                             Right_Scalar  => Complex,
263
                             Result_Scalar => Complex,
264
                             Left_Matrix   => Real_Matrix,
265
                             Right_Matrix  => Complex_Matrix,
266
                             Result_Matrix => Complex_Matrix,
267
                             Zero          => (0.0, 0.0));
268
 
269
      function "*" is new Matrix_Matrix_Product
270
                            (Left_Scalar   => Complex,
271
                             Right_Scalar  => Real'Base,
272
                             Result_Scalar => Complex,
273
                             Left_Matrix   => Complex_Matrix,
274
                             Right_Matrix  => Real_Matrix,
275
                             Result_Matrix => Complex_Matrix,
276
                             Zero          => (0.0, 0.0));
277
 
278
      ---------
279
      -- "+" --
280
      ---------
281
 
282
      function "+" is new Vector_Elementwise_Operation
283
                            (X_Scalar      => Complex,
284
                             Result_Scalar => Complex,
285
                             X_Vector      => Complex_Vector,
286
                             Result_Vector => Complex_Vector,
287
                             Operation     => "+");
288
 
289
      function "+" is new Vector_Vector_Elementwise_Operation
290
                            (Left_Scalar   => Complex,
291
                             Right_Scalar  => Complex,
292
                             Result_Scalar => Complex,
293
                             Left_Vector   => Complex_Vector,
294
                             Right_Vector  => Complex_Vector,
295
                             Result_Vector => Complex_Vector,
296
                             Operation     => "+");
297
 
298
      function "+" is new Vector_Vector_Elementwise_Operation
299
                            (Left_Scalar   => Real'Base,
300
                             Right_Scalar  => Complex,
301
                             Result_Scalar => Complex,
302
                             Left_Vector   => Real_Vector,
303
                             Right_Vector  => Complex_Vector,
304
                             Result_Vector => Complex_Vector,
305
                             Operation     => "+");
306
 
307
      function "+" is new Vector_Vector_Elementwise_Operation
308
                            (Left_Scalar   => Complex,
309
                             Right_Scalar  => Real'Base,
310
                             Result_Scalar => Complex,
311
                             Left_Vector   => Complex_Vector,
312
                             Right_Vector  => Real_Vector,
313
                             Result_Vector => Complex_Vector,
314
                             Operation     => "+");
315
 
316
      function "+" is new Matrix_Elementwise_Operation
317
                            (X_Scalar      => Complex,
318
                             Result_Scalar => Complex,
319
                             X_Matrix      => Complex_Matrix,
320
                             Result_Matrix => Complex_Matrix,
321
                             Operation     => "+");
322
 
323
      function "+" is new Matrix_Matrix_Elementwise_Operation
324
                            (Left_Scalar   => Complex,
325
                             Right_Scalar  => Complex,
326
                             Result_Scalar => Complex,
327
                             Left_Matrix   => Complex_Matrix,
328
                             Right_Matrix  => Complex_Matrix,
329
                             Result_Matrix => Complex_Matrix,
330
                             Operation     => "+");
331
 
332
      function "+" is new Matrix_Matrix_Elementwise_Operation
333
                            (Left_Scalar   => Real'Base,
334
                             Right_Scalar  => Complex,
335
                             Result_Scalar => Complex,
336
                             Left_Matrix   => Real_Matrix,
337
                             Right_Matrix  => Complex_Matrix,
338
                             Result_Matrix => Complex_Matrix,
339
                             Operation     => "+");
340
 
341
      function "+" is new Matrix_Matrix_Elementwise_Operation
342
                            (Left_Scalar   => Complex,
343
                             Right_Scalar  => Real'Base,
344
                             Result_Scalar => Complex,
345
                             Left_Matrix   => Complex_Matrix,
346
                             Right_Matrix  => Real_Matrix,
347
                             Result_Matrix => Complex_Matrix,
348
                             Operation     => "+");
349
 
350
      ---------
351
      -- "-" --
352
      ---------
353
 
354
      function "-" is new Vector_Elementwise_Operation
355
                            (X_Scalar      => Complex,
356
                             Result_Scalar => Complex,
357
                             X_Vector      => Complex_Vector,
358
                             Result_Vector => Complex_Vector,
359
                             Operation     => "-");
360
 
361
      function "-" is new Vector_Vector_Elementwise_Operation
362
                            (Left_Scalar   => Complex,
363
                             Right_Scalar  => Complex,
364
                             Result_Scalar => Complex,
365
                             Left_Vector   => Complex_Vector,
366
                             Right_Vector  => Complex_Vector,
367
                             Result_Vector => Complex_Vector,
368
                             Operation     => "-");
369
 
370
      function "-" is new Vector_Vector_Elementwise_Operation
371
                            (Left_Scalar   => Real'Base,
372
                             Right_Scalar  => Complex,
373
                             Result_Scalar => Complex,
374
                             Left_Vector   => Real_Vector,
375
                             Right_Vector  => Complex_Vector,
376
                             Result_Vector => Complex_Vector,
377
                             Operation     => "-");
378
 
379
      function "-" is new Vector_Vector_Elementwise_Operation
380
                            (Left_Scalar   => Complex,
381
                             Right_Scalar  => Real'Base,
382
                             Result_Scalar => Complex,
383
                             Left_Vector   => Complex_Vector,
384
                             Right_Vector  => Real_Vector,
385
                             Result_Vector => Complex_Vector,
386
                             Operation     => "-");
387
 
388
      function "-" is new Matrix_Elementwise_Operation
389
                            (X_Scalar      => Complex,
390
                             Result_Scalar => Complex,
391
                             X_Matrix      => Complex_Matrix,
392
                             Result_Matrix => Complex_Matrix,
393
                             Operation     => "-");
394
 
395
      function "-" is new Matrix_Matrix_Elementwise_Operation
396
                            (Left_Scalar   => Complex,
397
                             Right_Scalar  => Complex,
398
                             Result_Scalar => Complex,
399
                             Left_Matrix   => Complex_Matrix,
400
                             Right_Matrix  => Complex_Matrix,
401
                             Result_Matrix => Complex_Matrix,
402
                             Operation     => "-");
403
 
404
      function "-" is new Matrix_Matrix_Elementwise_Operation
405
                            (Left_Scalar   => Real'Base,
406
                             Right_Scalar  => Complex,
407
                             Result_Scalar => Complex,
408
                             Left_Matrix   => Real_Matrix,
409
                             Right_Matrix  => Complex_Matrix,
410
                             Result_Matrix => Complex_Matrix,
411
                             Operation     => "-");
412
 
413
      function "-" is new Matrix_Matrix_Elementwise_Operation
414
                            (Left_Scalar   => Complex,
415
                             Right_Scalar  => Real'Base,
416
                             Result_Scalar => Complex,
417
                             Left_Matrix   => Complex_Matrix,
418
                             Right_Matrix  => Real_Matrix,
419
                             Result_Matrix => Complex_Matrix,
420
                             Operation     => "-");
421
 
422
      ---------
423
      -- "/" --
424
      ---------
425
 
426
      function "/" is new Vector_Scalar_Elementwise_Operation
427
                            (Left_Scalar   => Complex,
428
                             Right_Scalar  => Complex,
429
                             Result_Scalar => Complex,
430
                             Left_Vector   => Complex_Vector,
431
                             Result_Vector => Complex_Vector,
432
                             Operation     => "/");
433
 
434
      function "/" is new Vector_Scalar_Elementwise_Operation
435
                            (Left_Scalar   => Complex,
436
                             Right_Scalar  => Real'Base,
437
                             Result_Scalar => Complex,
438
                             Left_Vector   => Complex_Vector,
439
                             Result_Vector => Complex_Vector,
440
                             Operation     => "/");
441
 
442
      function "/" is new Matrix_Scalar_Elementwise_Operation
443
                            (Left_Scalar   => Complex,
444
                             Right_Scalar  => Complex,
445
                             Result_Scalar => Complex,
446
                             Left_Matrix   => Complex_Matrix,
447
                             Result_Matrix => Complex_Matrix,
448
                             Operation     => "/");
449
 
450
      function "/" is new Matrix_Scalar_Elementwise_Operation
451
                            (Left_Scalar   => Complex,
452
                             Right_Scalar  => Real'Base,
453
                             Result_Scalar => Complex,
454
                             Left_Matrix   => Complex_Matrix,
455
                             Result_Matrix => Complex_Matrix,
456
                             Operation     => "/");
457
 
458
      -----------
459
      -- "abs" --
460
      -----------
461
 
462
      function "abs" is new L2_Norm
463
                              (X_Scalar      => Complex,
464
                               Result_Real   => Real'Base,
465
                               X_Vector      => Complex_Vector);
466
 
467
      --------------
468
      -- Argument --
469
      --------------
470
 
471
      function Argument is new Vector_Elementwise_Operation
472
                            (X_Scalar      => Complex,
473
                             Result_Scalar => Real'Base,
474
                             X_Vector      => Complex_Vector,
475
                             Result_Vector => Real_Vector,
476
                             Operation     => Argument);
477
 
478
      function Argument is new Vector_Scalar_Elementwise_Operation
479
                            (Left_Scalar   => Complex,
480
                             Right_Scalar  => Real'Base,
481
                             Result_Scalar => Real'Base,
482
                             Left_Vector   => Complex_Vector,
483
                             Result_Vector => Real_Vector,
484
                             Operation     => Argument);
485
 
486
      function Argument is new Matrix_Elementwise_Operation
487
                            (X_Scalar      => Complex,
488
                             Result_Scalar => Real'Base,
489
                             X_Matrix      => Complex_Matrix,
490
                             Result_Matrix => Real_Matrix,
491
                             Operation     => Argument);
492
 
493
      function Argument is new Matrix_Scalar_Elementwise_Operation
494
                            (Left_Scalar   => Complex,
495
                             Right_Scalar  => Real'Base,
496
                             Result_Scalar => Real'Base,
497
                             Left_Matrix   => Complex_Matrix,
498
                             Result_Matrix => Real_Matrix,
499
                             Operation     => Argument);
500
 
501
      ----------------------------
502
      -- Compose_From_Cartesian --
503
      ----------------------------
504
 
505
      function Compose_From_Cartesian is new Vector_Elementwise_Operation
506
                            (X_Scalar      => Real'Base,
507
                             Result_Scalar => Complex,
508
                             X_Vector      => Real_Vector,
509
                             Result_Vector => Complex_Vector,
510
                             Operation     => Compose_From_Cartesian);
511
 
512
      function Compose_From_Cartesian is
513
         new Vector_Vector_Elementwise_Operation
514
                            (Left_Scalar   => Real'Base,
515
                             Right_Scalar  => Real'Base,
516
                             Result_Scalar => Complex,
517
                             Left_Vector   => Real_Vector,
518
                             Right_Vector  => Real_Vector,
519
                             Result_Vector => Complex_Vector,
520
                             Operation     => Compose_From_Cartesian);
521
 
522
      function Compose_From_Cartesian is new Matrix_Elementwise_Operation
523
                            (X_Scalar      => Real'Base,
524
                             Result_Scalar => Complex,
525
                             X_Matrix      => Real_Matrix,
526
                             Result_Matrix => Complex_Matrix,
527
                             Operation     => Compose_From_Cartesian);
528
 
529
      function Compose_From_Cartesian is
530
         new Matrix_Matrix_Elementwise_Operation
531
                            (Left_Scalar   => Real'Base,
532
                             Right_Scalar  => Real'Base,
533
                             Result_Scalar => Complex,
534
                             Left_Matrix   => Real_Matrix,
535
                             Right_Matrix  => Real_Matrix,
536
                             Result_Matrix => Complex_Matrix,
537
                             Operation     => Compose_From_Cartesian);
538
 
539
      ------------------------
540
      -- Compose_From_Polar --
541
      ------------------------
542
 
543
      function Compose_From_Polar is
544
        new Vector_Vector_Elementwise_Operation
545
                            (Left_Scalar   => Real'Base,
546
                             Right_Scalar  => Real'Base,
547
                             Result_Scalar => Complex,
548
                             Left_Vector   => Real_Vector,
549
                             Right_Vector  => Real_Vector,
550
                             Result_Vector => Complex_Vector,
551
                             Operation     => Compose_From_Polar);
552
 
553
      function Compose_From_Polar is
554
        new Vector_Vector_Scalar_Elementwise_Operation
555
                            (X_Scalar      => Real'Base,
556
                             Y_Scalar      => Real'Base,
557
                             Z_Scalar      => Real'Base,
558
                             Result_Scalar => Complex,
559
                             X_Vector      => Real_Vector,
560
                             Y_Vector      => Real_Vector,
561
                             Result_Vector => Complex_Vector,
562
                             Operation     => Compose_From_Polar);
563
 
564
      function Compose_From_Polar is
565
        new Matrix_Matrix_Elementwise_Operation
566
                            (Left_Scalar   => Real'Base,
567
                             Right_Scalar  => Real'Base,
568
                             Result_Scalar => Complex,
569
                             Left_Matrix   => Real_Matrix,
570
                             Right_Matrix  => Real_Matrix,
571
                             Result_Matrix => Complex_Matrix,
572
                             Operation     => Compose_From_Polar);
573
 
574
      function Compose_From_Polar is
575
        new Matrix_Matrix_Scalar_Elementwise_Operation
576
                            (X_Scalar      => Real'Base,
577
                             Y_Scalar      => Real'Base,
578
                             Z_Scalar      => Real'Base,
579
                             Result_Scalar => Complex,
580
                             X_Matrix      => Real_Matrix,
581
                             Y_Matrix      => Real_Matrix,
582
                             Result_Matrix => Complex_Matrix,
583
                             Operation     => Compose_From_Polar);
584
 
585
      ---------------
586
      -- Conjugate --
587
      ---------------
588
 
589
      function Conjugate is new Vector_Elementwise_Operation
590
                            (X_Scalar      => Complex,
591
                             Result_Scalar => Complex,
592
                             X_Vector      => Complex_Vector,
593
                             Result_Vector => Complex_Vector,
594
                             Operation     => Conjugate);
595
 
596
      function Conjugate is new Matrix_Elementwise_Operation
597
                            (X_Scalar      => Complex,
598
                             Result_Scalar => Complex,
599
                             X_Matrix      => Complex_Matrix,
600
                             Result_Matrix => Complex_Matrix,
601
                             Operation     => Conjugate);
602
 
603
      --------
604
      -- Im --
605
      --------
606
 
607
      function Im is new Vector_Elementwise_Operation
608
                            (X_Scalar      => Complex,
609
                             Result_Scalar => Real'Base,
610
                             X_Vector      => Complex_Vector,
611
                             Result_Vector => Real_Vector,
612
                             Operation     => Im);
613
 
614
      function Im is new Matrix_Elementwise_Operation
615
                            (X_Scalar      => Complex,
616
                             Result_Scalar => Real'Base,
617
                             X_Matrix      => Complex_Matrix,
618
                             Result_Matrix => Real_Matrix,
619
                             Operation     => Im);
620
 
621
      -------------
622
      -- Modulus --
623
      -------------
624
 
625
      function Modulus is new Vector_Elementwise_Operation
626
                            (X_Scalar      => Complex,
627
                             Result_Scalar => Real'Base,
628
                             X_Vector      => Complex_Vector,
629
                             Result_Vector => Real_Vector,
630
                             Operation     => Modulus);
631
 
632
      function Modulus is new Matrix_Elementwise_Operation
633
                            (X_Scalar      => Complex,
634
                             Result_Scalar => Real'Base,
635
                             X_Matrix      => Complex_Matrix,
636
                             Result_Matrix => Real_Matrix,
637
                             Operation     => Modulus);
638
 
639
      --------
640
      -- Re --
641
      --------
642
 
643
      function Re is new Vector_Elementwise_Operation
644
                            (X_Scalar      => Complex,
645
                             Result_Scalar => Real'Base,
646
                             X_Vector      => Complex_Vector,
647
                             Result_Vector => Real_Vector,
648
                             Operation     => Re);
649
 
650
      function Re is new Matrix_Elementwise_Operation
651
                            (X_Scalar      => Complex,
652
                             Result_Scalar => Real'Base,
653
                             X_Matrix      => Complex_Matrix,
654
                             Result_Matrix => Real_Matrix,
655
                             Operation     => Re);
656
 
657
      ------------
658
      -- Set_Im --
659
      ------------
660
 
661
      procedure Set_Im is new Update_Vector_With_Vector
662
                            (X_Scalar      => Complex,
663
                             Y_Scalar      => Real'Base,
664
                             X_Vector      => Complex_Vector,
665
                             Y_Vector      => Real_Vector,
666
                             Update        => Set_Im);
667
 
668
      procedure Set_Im is new Update_Matrix_With_Matrix
669
                            (X_Scalar      => Complex,
670
                             Y_Scalar      => Real'Base,
671
                             X_Matrix      => Complex_Matrix,
672
                             Y_Matrix      => Real_Matrix,
673
                             Update        => Set_Im);
674
 
675
      ------------
676
      -- Set_Re --
677
      ------------
678
 
679
      procedure Set_Re is new Update_Vector_With_Vector
680
                            (X_Scalar      => Complex,
681
                             Y_Scalar      => Real'Base,
682
                             X_Vector      => Complex_Vector,
683
                             Y_Vector      => Real_Vector,
684
                             Update        => Set_Re);
685
 
686
      procedure Set_Re is new Update_Matrix_With_Matrix
687
                            (X_Scalar      => Complex,
688
                             Y_Scalar      => Real'Base,
689
                             X_Matrix      => Complex_Matrix,
690
                             Y_Matrix      => Real_Matrix,
691
                             Update        => Set_Re);
692
 
693
      -----------
694
      -- Solve --
695
      -----------
696
 
697
      function Solve is
698
         new Matrix_Vector_Solution (Complex, Complex_Vector, Complex_Matrix);
699
 
700
      function Solve is
701
         new Matrix_Matrix_Solution (Complex, Complex_Matrix);
702
 
703
      -----------------
704
      -- Unit_Matrix --
705
      -----------------
706
 
707
      function Unit_Matrix is new System.Generic_Array_Operations.Unit_Matrix
708
                            (Scalar        => Complex,
709
                             Matrix        => Complex_Matrix,
710
                             Zero          => (0.0, 0.0),
711
                             One           => (1.0, 0.0));
712
 
713
      function Unit_Vector is new System.Generic_Array_Operations.Unit_Vector
714
                            (Scalar        => Complex,
715
                             Vector        => Complex_Vector,
716
                             Zero          => (0.0, 0.0),
717
                             One           => (1.0, 0.0));
718
   end Instantiations;
719
 
720
   ---------
721
   -- "*" --
722
   ---------
723
 
724
   function "*"
725
     (Left  : Complex_Vector;
726
      Right : Complex_Vector) return Complex
727
     renames Instantiations."*";
728
 
729
   function "*"
730
     (Left  : Real_Vector;
731
      Right : Complex_Vector) return Complex
732
     renames Instantiations."*";
733
 
734
   function "*"
735
     (Left  : Complex_Vector;
736
      Right : Real_Vector) return Complex
737
     renames Instantiations."*";
738
 
739
   function "*"
740
     (Left  : Complex;
741
      Right : Complex_Vector) return Complex_Vector
742
     renames Instantiations."*";
743
 
744
   function "*"
745
     (Left  : Complex_Vector;
746
      Right : Complex) return Complex_Vector
747
     renames Instantiations."*";
748
 
749
   function "*"
750
     (Left  : Real'Base;
751
      Right : Complex_Vector) return Complex_Vector
752
     renames Instantiations."*";
753
 
754
   function "*"
755
     (Left  : Complex_Vector;
756
      Right : Real'Base) return Complex_Vector
757
     renames Instantiations."*";
758
 
759
   function "*"
760
     (Left  : Complex_Matrix;
761
      Right : Complex_Matrix) return  Complex_Matrix
762
     renames Instantiations."*";
763
 
764
   function "*"
765
     (Left  : Complex_Vector;
766
      Right : Complex_Vector) return Complex_Matrix
767
     renames Instantiations."*";
768
 
769
   function "*"
770
     (Left  : Complex_Vector;
771
      Right : Complex_Matrix) return Complex_Vector
772
     renames Instantiations."*";
773
 
774
   function "*"
775
     (Left  : Complex_Matrix;
776
      Right : Complex_Vector) return Complex_Vector
777
     renames Instantiations."*";
778
 
779
   function "*"
780
     (Left  : Real_Matrix;
781
      Right : Complex_Matrix) return Complex_Matrix
782
     renames Instantiations."*";
783
 
784
   function "*"
785
     (Left  : Complex_Matrix;
786
      Right : Real_Matrix) return Complex_Matrix
787
     renames Instantiations."*";
788
 
789
   function "*"
790
     (Left  : Real_Vector;
791
      Right : Complex_Vector) return Complex_Matrix
792
     renames Instantiations."*";
793
 
794
   function "*"
795
     (Left  : Complex_Vector;
796
      Right : Real_Vector) return Complex_Matrix
797
     renames Instantiations."*";
798
 
799
   function "*"
800
     (Left  : Real_Vector;
801
      Right : Complex_Matrix) return Complex_Vector
802
     renames Instantiations."*";
803
 
804
   function "*"
805
     (Left  : Complex_Vector;
806
      Right : Real_Matrix) return Complex_Vector
807
     renames Instantiations."*";
808
 
809
   function "*"
810
     (Left  : Real_Matrix;
811
      Right : Complex_Vector) return Complex_Vector
812
     renames Instantiations."*";
813
 
814
   function "*"
815
     (Left  : Complex_Matrix;
816
      Right : Real_Vector) return Complex_Vector
817
     renames Instantiations."*";
818
 
819
   function "*"
820
     (Left  : Complex;
821
      Right : Complex_Matrix) return Complex_Matrix
822
     renames Instantiations."*";
823
 
824
   function "*"
825
     (Left  : Complex_Matrix;
826
      Right : Complex) return Complex_Matrix
827
     renames Instantiations."*";
828
 
829
   function "*"
830
     (Left  : Real'Base;
831
      Right : Complex_Matrix) return Complex_Matrix
832
     renames Instantiations."*";
833
 
834
   function "*"
835
     (Left  : Complex_Matrix;
836
      Right : Real'Base) return Complex_Matrix
837
     renames Instantiations."*";
838
 
839
   ---------
840
   -- "+" --
841
   ---------
842
 
843
   function "+" (Right : Complex_Vector) return Complex_Vector
844
     renames Instantiations."+";
845
 
846
   function "+"
847
     (Left  : Complex_Vector;
848
      Right : Complex_Vector) return Complex_Vector
849
     renames Instantiations."+";
850
 
851
   function "+"
852
     (Left  : Real_Vector;
853
      Right : Complex_Vector) return Complex_Vector
854
     renames Instantiations."+";
855
 
856
   function "+"
857
     (Left  : Complex_Vector;
858
      Right : Real_Vector) return Complex_Vector
859
     renames Instantiations."+";
860
 
861
   function "+" (Right : Complex_Matrix) return Complex_Matrix
862
     renames Instantiations."+";
863
 
864
   function "+"
865
     (Left  : Complex_Matrix;
866
      Right : Complex_Matrix) return Complex_Matrix
867
     renames Instantiations."+";
868
 
869
   function "+"
870
     (Left  : Real_Matrix;
871
      Right : Complex_Matrix) return Complex_Matrix
872
     renames Instantiations."+";
873
 
874
   function "+"
875
     (Left  : Complex_Matrix;
876
      Right : Real_Matrix) return Complex_Matrix
877
     renames Instantiations."+";
878
 
879
   ---------
880
   -- "-" --
881
   ---------
882
 
883
   function "-"
884
     (Right : Complex_Vector) return Complex_Vector
885
     renames Instantiations."-";
886
 
887
   function "-"
888
     (Left  : Complex_Vector;
889
      Right : Complex_Vector) return Complex_Vector
890
     renames Instantiations."-";
891
 
892
   function "-"
893
     (Left  : Real_Vector;
894
      Right : Complex_Vector) return Complex_Vector
895
      renames Instantiations."-";
896
 
897
   function "-"
898
     (Left  : Complex_Vector;
899
      Right : Real_Vector) return Complex_Vector
900
     renames Instantiations."-";
901
 
902
   function "-" (Right : Complex_Matrix) return Complex_Matrix
903
     renames Instantiations."-";
904
 
905
   function "-"
906
     (Left  : Complex_Matrix;
907
      Right : Complex_Matrix) return Complex_Matrix
908
     renames Instantiations."-";
909
 
910
   function "-"
911
     (Left  : Real_Matrix;
912
      Right : Complex_Matrix) return Complex_Matrix
913
     renames Instantiations."-";
914
 
915
   function "-"
916
     (Left  : Complex_Matrix;
917
      Right : Real_Matrix) return Complex_Matrix
918
     renames Instantiations."-";
919
 
920
   ---------
921
   -- "/" --
922
   ---------
923
 
924
   function "/"
925
     (Left  : Complex_Vector;
926
      Right : Complex) return Complex_Vector
927
     renames Instantiations."/";
928
 
929
   function "/"
930
     (Left  : Complex_Vector;
931
      Right : Real'Base) return Complex_Vector
932
     renames Instantiations."/";
933
 
934
   function "/"
935
     (Left  : Complex_Matrix;
936
      Right : Complex) return Complex_Matrix
937
     renames Instantiations."/";
938
 
939
   function "/"
940
     (Left  : Complex_Matrix;
941
      Right : Real'Base) return Complex_Matrix
942
     renames Instantiations."/";
943
 
944
   -----------
945
   -- "abs" --
946
   -----------
947
 
948
   function "abs" (Right : Complex_Vector) return Real'Base
949
      renames Instantiations."abs";
950
 
951
   --------------
952
   -- Argument --
953
   --------------
954
 
955
   function Argument (X : Complex_Vector) return Real_Vector
956
     renames Instantiations.Argument;
957
 
958
   function Argument
959
     (X     : Complex_Vector;
960
      Cycle : Real'Base) return Real_Vector
961
     renames Instantiations.Argument;
962
 
963
   function Argument (X : Complex_Matrix) return Real_Matrix
964
     renames Instantiations.Argument;
965
 
966
   function Argument
967
     (X     : Complex_Matrix;
968
      Cycle : Real'Base) return Real_Matrix
969
     renames Instantiations.Argument;
970
 
971
   ----------------------------
972
   -- Compose_From_Cartesian --
973
   ----------------------------
974
 
975
   function Compose_From_Cartesian (Re : Real_Vector) return Complex_Vector
976
     renames Instantiations.Compose_From_Cartesian;
977
 
978
   function Compose_From_Cartesian
979
     (Re : Real_Vector;
980
      Im : Real_Vector) return Complex_Vector
981
     renames Instantiations.Compose_From_Cartesian;
982
 
983
   function Compose_From_Cartesian (Re : Real_Matrix) return Complex_Matrix
984
     renames Instantiations.Compose_From_Cartesian;
985
 
986
   function Compose_From_Cartesian
987
     (Re : Real_Matrix;
988
      Im : Real_Matrix) return Complex_Matrix
989
     renames Instantiations.Compose_From_Cartesian;
990
 
991
   ------------------------
992
   -- Compose_From_Polar --
993
   ------------------------
994
 
995
   function Compose_From_Polar
996
     (Modulus  : Real_Vector;
997
      Argument : Real_Vector) return Complex_Vector
998
     renames Instantiations.Compose_From_Polar;
999
 
1000
   function Compose_From_Polar
1001
     (Modulus  : Real_Vector;
1002
      Argument : Real_Vector;
1003
      Cycle    : Real'Base) return Complex_Vector
1004
     renames Instantiations.Compose_From_Polar;
1005
 
1006
   function Compose_From_Polar
1007
     (Modulus  : Real_Matrix;
1008
      Argument : Real_Matrix) return Complex_Matrix
1009
     renames Instantiations.Compose_From_Polar;
1010
 
1011
   function Compose_From_Polar
1012
     (Modulus  : Real_Matrix;
1013
      Argument : Real_Matrix;
1014
      Cycle    : Real'Base) return Complex_Matrix
1015
     renames Instantiations.Compose_From_Polar;
1016
 
1017
   ---------------
1018
   -- Conjugate --
1019
   ---------------
1020
 
1021
   function Conjugate (X : Complex_Vector) return Complex_Vector
1022
     renames Instantiations.Conjugate;
1023
 
1024
   function Conjugate (X : Complex_Matrix) return Complex_Matrix
1025
     renames Instantiations.Conjugate;
1026
 
1027
   -----------------
1028
   -- Determinant --
1029
   -----------------
1030
 
1031
   function Determinant (A : Complex_Matrix) return Complex is
1032
      M : Complex_Matrix := A;
1033
      B : Complex_Matrix (A'Range (1), 1 .. 0);
1034
      R : Complex;
1035
   begin
1036
      Forward_Eliminate (M, B, R);
1037
      return R;
1038
   end Determinant;
1039
 
1040
   -----------------
1041
   -- Eigensystem --
1042
   -----------------
1043
 
1044
   procedure Eigensystem
1045
     (A       : Complex_Matrix;
1046
      Values  : out Real_Vector;
1047
      Vectors : out Complex_Matrix)
1048
   is
1049
      N : constant Natural := Length (A);
1050
 
1051
      --  For a Hermitian matrix C, we convert the eigenvalue problem to a
1052
      --  real symmetric one: if C = A + i * B, then the (N, N) complex
1053
      --  eigenvalue problem:
1054
      --     (A + i * B) * (u + i * v) = Lambda * (u + i * v)
1055
      --
1056
      --  is equivalent to the (2 * N, 2 * N) real eigenvalue problem:
1057
      --     [  A, B ] [ u ] = Lambda * [ u ]
1058
      --     [ -B, A ] [ v ]            [ v ]
1059
      --
1060
      --  Note that the (2 * N, 2 * N) matrix above is symmetric, as
1061
      --  Transpose (A) = A and Transpose (B) = -B if C is Hermitian.
1062
 
1063
      --  We solve this eigensystem using the real-valued algorithms. The final
1064
      --  result will have every eigenvalue twice, so in the sorted output we
1065
      --  just pick every second value, with associated eigenvector u + i * v.
1066
 
1067
      M    : Real_Matrix (1 .. 2 * N, 1 .. 2 * N);
1068
      Vals : Real_Vector (1 .. 2 * N);
1069
      Vecs : Real_Matrix (1 .. 2 * N, 1 .. 2 * N);
1070
 
1071
   begin
1072
      for J in 1 .. N loop
1073
         for K in 1 .. N loop
1074
            declare
1075
               C : constant Complex :=
1076
                     (A (A'First (1) + (J - 1), A'First (2) + (K - 1)));
1077
            begin
1078
               M (J, K) := Re (C);
1079
               M (J + N, K + N) := Re (C);
1080
               M (J + N, K) := Im (C);
1081
               M (J, K + N) := -Im (C);
1082
            end;
1083
         end loop;
1084
      end loop;
1085
 
1086
      Eigensystem (M, Vals, Vecs);
1087
 
1088
      for J in 1 .. N loop
1089
         declare
1090
            Col : constant Integer := Values'First + (J - 1);
1091
         begin
1092
            Values (Col) := Vals (2 * J);
1093
 
1094
            for K in 1 .. N loop
1095
               declare
1096
                  Row : constant Integer := Vectors'First (2) + (K - 1);
1097
               begin
1098
                  Vectors (Row, Col)
1099
                     := (Vecs (J * 2, Col), Vecs (J * 2, Col + N));
1100
               end;
1101
            end loop;
1102
         end;
1103
      end loop;
1104
   end Eigensystem;
1105
 
1106
   -----------------
1107
   -- Eigenvalues --
1108
   -----------------
1109
 
1110
   function Eigenvalues (A : Complex_Matrix) return Real_Vector is
1111
      --  See Eigensystem for a description of the algorithm
1112
 
1113
      N : constant Natural := Length (A);
1114
      R : Real_Vector (A'Range (1));
1115
 
1116
      M    : Real_Matrix (1 .. 2 * N, 1 .. 2 * N);
1117
      Vals : Real_Vector (1 .. 2 * N);
1118
   begin
1119
      for J in 1 .. N loop
1120
         for K in 1 .. N loop
1121
            declare
1122
               C : constant Complex :=
1123
                     (A (A'First (1) + (J - 1), A'First (2) + (K - 1)));
1124
            begin
1125
               M (J, K) := Re (C);
1126
               M (J + N, K + N) := Re (C);
1127
               M (J + N, K) := Im (C);
1128
               M (J, K + N) := -Im (C);
1129
            end;
1130
         end loop;
1131
      end loop;
1132
 
1133
      Vals := Eigenvalues (M);
1134
 
1135
      for J in 1 .. N loop
1136
         R (A'First (1) + (J - 1)) := Vals (2 * J);
1137
      end loop;
1138
 
1139
      return R;
1140
   end Eigenvalues;
1141
 
1142
   --------
1143
   -- Im --
1144
   --------
1145
 
1146
   function Im (X : Complex_Vector) return Real_Vector
1147
     renames Instantiations.Im;
1148
 
1149
   function Im (X : Complex_Matrix) return Real_Matrix
1150
     renames Instantiations.Im;
1151
 
1152
   -------------
1153
   -- Inverse --
1154
   -------------
1155
 
1156
   function Inverse (A : Complex_Matrix) return Complex_Matrix is
1157
     (Solve (A, Unit_Matrix (Length (A))));
1158
 
1159
   -------------
1160
   -- Modulus --
1161
   -------------
1162
 
1163
   function Modulus (X : Complex_Vector) return Real_Vector
1164
     renames Instantiations.Modulus;
1165
 
1166
   function Modulus (X : Complex_Matrix) return Real_Matrix
1167
     renames Instantiations.Modulus;
1168
 
1169
   --------
1170
   -- Re --
1171
   --------
1172
 
1173
   function Re (X : Complex_Vector) return Real_Vector
1174
     renames Instantiations.Re;
1175
 
1176
   function Re (X : Complex_Matrix) return Real_Matrix
1177
     renames Instantiations.Re;
1178
 
1179
   ------------
1180
   -- Set_Im --
1181
   ------------
1182
 
1183
   procedure Set_Im
1184
     (X  : in out Complex_Matrix;
1185
      Im : Real_Matrix)
1186
     renames Instantiations.Set_Im;
1187
 
1188
   procedure Set_Im
1189
     (X  : in out Complex_Vector;
1190
      Im : Real_Vector)
1191
     renames Instantiations.Set_Im;
1192
 
1193
   ------------
1194
   -- Set_Re --
1195
   ------------
1196
 
1197
   procedure Set_Re
1198
     (X  : in out Complex_Matrix;
1199
      Re : Real_Matrix)
1200
     renames Instantiations.Set_Re;
1201
 
1202
   procedure Set_Re
1203
     (X  : in out Complex_Vector;
1204
      Re : Real_Vector)
1205
     renames Instantiations.Set_Re;
1206
 
1207
   -----------
1208
   -- Solve --
1209
   -----------
1210
 
1211
   function Solve
1212
     (A : Complex_Matrix;
1213
      X : Complex_Vector) return Complex_Vector
1214
     renames Instantiations.Solve;
1215
 
1216
   function Solve
1217
     (A : Complex_Matrix;
1218
      X : Complex_Matrix) return Complex_Matrix
1219
     renames Instantiations.Solve;
1220
 
1221
   ---------------
1222
   -- Transpose --
1223
   ---------------
1224
 
1225
   function Transpose
1226
     (X : Complex_Matrix) return Complex_Matrix
1227
   is
1228
      R : Complex_Matrix (X'Range (2), X'Range (1));
1229
   begin
1230
      Transpose (X, R);
1231
      return R;
1232
   end Transpose;
1233
 
1234
   -----------------
1235
   -- Unit_Matrix --
1236
   -----------------
1237
 
1238
   function Unit_Matrix
1239
     (Order   : Positive;
1240
      First_1 : Integer := 1;
1241
      First_2 : Integer := 1) return Complex_Matrix
1242
     renames Instantiations.Unit_Matrix;
1243
 
1244
   -----------------
1245
   -- Unit_Vector --
1246
   -----------------
1247
 
1248
   function Unit_Vector
1249
     (Index : Integer;
1250
      Order : Positive;
1251
      First : Integer := 1) return Complex_Vector
1252
     renames Instantiations.Unit_Vector;
1253
 
1254
end Ada.Numerics.Generic_Complex_Arrays;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.